perm filename SFTP.BLI[IP,SYS] blob
sn#699439 filedate 1983-02-07 generic text, type T, neo UTF8
module SubFTP(reserve(0),sreg=#17)=
begin
% Subroutine version of FTP so that the same code can
be used by user "R FTP" and QNET daemon.
Returns TRUE if OK or "user unknown"-type error,
false if requeue. %
external INITPTYS,GETPTY,PTYLOG,PTYKJOB,PTYRELEASE,PTYMONMOD,PTYOC,PTYOSTR,PTYINC;
external PTYINW,PTYCLRBUF,PTYHIBER,WAITIN,WAITMON,WAITOUT,INMON,PTYHASOUT;
! Get host-table-manager definitions.
require HstBli.req;
global routine SFTP(UPPN,EntCCL,EntQn)=
begin
% RIC WERME, 1972-1973
DIANA BAJZEK 1975-1979
don provan, 1980 [96bit]
Craig Everhart, 1980 (new host table support)
This is a USER end of the FTP User/Server method
for effecting file transfer. %
bind FILLIMIT=31;
!!bind QTIMELIMIT=3; !LIMIT ENTRIES TO 3 DAYS IN QUEUE
!!bind QTimeLimit=14; ! 2 weeks for KL to come back up;
bind QTimeLimit=9; ![CFE] Different random constant;
![96bit] OWN SELFSIT,SELFHOS,SELFADR;
GLOBAL INTBLK[3];
GLOBAL FILBLK[20];
BIND STARTOWN=FILBLK; !BEGINNING OF VARIABLES TO BE CLEARED ON SUBROUTINE ENTRY*****
bind FILXCT=FILBLK[0],
FILCHAN=FILBLK[3]<23,4>,
FILDEV=FILBLK[5],
FILHDP=FILBLK[6],
FILNAM=FILBLK[7],
FILEXT=FILBLK[8],
FILPPN=FILBLK[11],
TTOBHD=FILBLK[12];
bind ImpBlkSize = 6; ![96bit] imp blocks are this long
bind HNamSiz = 10; ![CFE] Words to store ASCIZ host names.
GLOBAL TELIBK[ImpBlkSize],
![tcp] TELOBK[ImpBlkSize],
![tcp] ICPBLK[ImpBlkSize],
DATBLK[ImpBlkSize],
LclName[HNamSiz], ![CFE] Local-site information:
LclNum,
LclSts,
RmtName[HNamSiz], ![CFE] and remote-site information.
RmtNum,
RmtSts,
! TmpName[HNamSiz], ![CFE] Temporary name for scanning into
TTIBHD[3],
XFRIBD[3],
XFROBD[3],
TELIBD[3],
TELOBD[3],
![tcp] ICPBHD[3],
ATFIBD[3],ATFOBD[3],
TMPBHD[3],
QIBHD[3],QOBHD[3],
UFDIBD[3],
CMUPPN[3],
CCLENTRY,USRPPN,QNETENTRY,DOCMD,
EchoOff, ! set to -1 if command file input should not be echoed
LCLSKT,
REMSKT,
DATSKT,
ICPSKT,
REMSIT, !SITE # WE'RE GOING TO
NCPDOWN, !TRUE IF THE NCP IS NOT RUNNING
TELLOG, !LOGICAL NAME FOR CURRENT LCLSKT
TELPHY, !PHYSICAL NAME FOR CURRENT LCLSKT
MAXMES, !THE MAXIMUM MESSAGE # ON A COMMAND
MATCHMES, !IF CONTINUATION LINE, THIS IS THE CODE WE ARE MATCHING
CONTMES, !TRUE IF - CONTINUATION LINES REQUESTED
MULTY, !SET PARAMETERS FOR CONTINUATION LINES
SLPTIM, !HOW LONG TO SLEEP IN THE WAIT ROUTINE.
![tcp] CURTYP, !ASCII LETTER CODE OF CURRENT TYPE
![tcp] IOMODE, !BINARY IO MODE THAT TRANSLATES INTO
![tcp] CURBYT, !PARAM TO LAST BYTE CMD
![tcp] USEBYT, !THE BYTE SIZE TO USE (TYPE A REQUIRES 8)
HSTJBF,
XFRJBF,
FILNAMES[FILLIMIT],FILSAV[FILLIMIT],
FILCNT,FSAVCNT,
CCLFIL,
JOBSTATUS,
IOWORDCOUNT,
BADHOST,
CMDCOUNT,CMDPNT,CMDBUF[41],DOQUEUE,BADNAME,
LASCHR, !LAST CHAR SEEN BY TELICH
LASTCH, !LAST CHAR SEEN BY TTICHR
FILLEN, !LENGTH OF PATHAME STRING PARSED BY FILSCN
FILPNT, !POINTER TO THAT STRING
TEMP,
TempCh, ! Character skipped by InDec()
CNT,
TIME,
DEV,
FILE,
EXT,
ANSCOUNT,ANSWPT,ANSWER[101],
SAVPTR,
TIMSTRNG[8],
PPN;
BIND ENDOWN=PPN; !END OF VARIABLES TO BE CLEARED*****
BIND ANSCNT=100*5,CMDCNT=40*5;
BIND
CMUsite = 14, ![96bit] cmu is imp 14
F=0<0,36>,
IDBLST=#51,
MINERR=300,
IOALL=#760000,
IOERR=#740000,
DATIBK=DATBLK,
DATOBK=DATBLK,
PGMARK=#201004020101,
JBTNM1=-1↑18+#31, !GETTAB INDEX FOR USER'S NAME
JBTNM2=-1↑18+#32, !WHICH IS 2 WORDS LONG
FILCHN=1,
TTICHN=2, !TTY INPUT CHANNEL [MAY BE READING FROM FTP FILE INSTEAD]
DATCHN=3,
TELCHN=4,
![tcp] ICPCHN=5,
ATFCHN=6,
QCHN=7, !CHANNEL FOR QUEUEING COMMANDS TO FTP.Q FILE
TTOCHN=#10, !TTY OUTPUT CHANNEL [MAY BE WRITING TO FTP.LOG FILE INSTEAD]
UFDCHN=#11,
TMPCHN=#12,
PTYCHN=#15; !CHANNEL FOR RUNNING MAIL VIA A PTY INSTEAD OF NETWORK
external O1Byte, EFile; ! These are in TULLIB;
BIND COMTAB=PLIT (SIXBIT ' LOCAL ICP HASH VERBOSSLEEP AUTO DDT HELP QUIT STATUSTYPE SMLFL BYTE HOST ',
SIXBIT 'USER PASSWOACCOUNBYE STORE RETRIELIST MLFL MAIL RENAMEDELETESEARCHCPATH COPY XPATCH'),
FIRTEL=15,
SMLFLCMD=12, !ONLY ALLOW SMLFL COMMAND FOR QNET
MLFLCMD=22, !XFRFIL NEEDS TO KNOW IF IT SHOULD SEND HEADER
FIRNORM=9, !RANGE TO SUPPRESS COMMON MSGS
LSTNORM=26;
BIND
IMPIMP=0,
IMPLOG=1,
IMPSTT=1,
IMPERR=1,
IMPLCL=2,
IMPHST=3,
IMPRMT=4,
![tcp] ImpByte = 5, ![96bit] where the byte is kept.
ASCBYT=8, !BYTE SIZE FOR ASCII XFERS
![tcp] IMGBYT=36, !BYTE SIZE FOR IMAGE XFERS
TELSKT=1,
FTPSKT=3,
BHDBUF=0,
BHDPNT=1,
BHDCNT=2,
A=0,
AL=1,
IMG=#10,
BIN=#14;
OWN TELMSG[25],TELCNT,TELPNT;
BIND TELLEN=124,LSTCMDOK=200;
MACRO
VEND=RETURN .VREG END$,
STRP(X)=((X)-1)<1,7>$,
IMPUUO(R)=CALL(R,PLIT SIXBIT 'IMPUUO')$, !A HACK TO LET HARVARD USE OUR CODE
DECCMU(R)=CALL(R,PLIT SIXBIT 'DECCMU')$,
CMUDEC(R)=CALL(R,PLIT SIXBIT 'CMUDEC')$,
RESET=CALLI(0,0)$,
EXECOP(OP,REG,ADDRESS)=(REGISTER Q;Q←(OP)↑27+(REG)↑23+(ADDRESS)<ADDR>;SKIP(XCT(0,Q)))$,
DEVCHR(R)=CALLI(R,#4)$,
LOGOUT=CALLI(0,#17)$,
STOP(R)=(
IF .QNETENTRY THEN (DOCMD←FALSE;RETURN) ELSE CALLI(R,#12))$,
EXITT(A)= CALLI(A,#12)$,
MSTIME(R)=CALLI(R,#23)$,
DATE=(REGISTER Q; CALLI(Q,#14))$,
JSTATLOGGED=JOBSTATUS<20,1>$, !true if logged in
GETPPN(R)=CALLI(R,#24)$,
PJOB(R)=CALLI(R,#30)$,
SLEEP(R)=CALLI(R,#31)$,
GETTAB(R)=SKIP(CALLI(R,#41))$,
DEVNAM(R)=CALLI(R,#64)$,
HIBER(R)=CALLI(R,#72)$,
GETLCH(R)=TTCALL(6,R)$,
INCHWL(R)=TTCALL(0,R)$,
OUTCHR(R)=TTCALL(1,R)$,
SKIPNC=TTCALL(#13)$,
SKIPNL=TTCALL(#14)$,
NEWLIN=(LASTCH←TTIBHD[BHDCNT]←0;F<CRLFIN>←FALSE)$, !FORCE INPUT ON NEXT CALL TO TTICHR
SAVECH(R)=(LASTCH←R)$,
ECHO=SETSTS(TTICHN,AL)$,
NOECHO=SETSTS(TTICHN,#200+AL)$,
CLOSCN(IB)=(STATUS(IB<ADDR>);.IB[IMPLOG]<RH> EQL 0)$,
![tcp] RFCIN(IB) =(STATUS(IB<ADDR>);.IB[IMPLOG]<RH> EQL 2)$,
SiteNumber = 0,16$, ![96bit] site number of a imp address
HostNumber = 16,8$, ![96bit] host number of a imp address
MAILBIT= 0,1$, !SEND MAIL INSTEAD OF MLFL TO THIS HOST
NOQBIT =1,1$, !DON'T QUEUE REQUESTS TO THIS HOST
USRBIT =2,1$, !SEND USER AND PASS TO THIS HOST
!IN REG F
IOIMPM=17,1$, !STATUS BIT FOR IMPROPER MODE
IOEOF=13,1$, !STATUS BIT FOR END OF FILE
IODATA=10,1$, !STATUS BIT SAYING IMP INPUT IN
!FLAGS IN GETLCH WORD:
PRMFLG=35,1$, !OUR OWN, SAYING WE MUST PROMPT
TT2741=28,1$, !WE'RE ON A 2741 (YECH)
LCP=20,1$, !HE DID A TTY NO ECHO
NEC=34,1$, !OUR OWN, SET ON A REGULAR TTY
CRLFIN=35,1$,
MESSAGE=34,1$, !NON-RECOVERABLE ERROR - MAIL A MESSAGE TO SENDER
CMULNK=33,1$, !SET FOR CMU-CMU FTP'S, TO DO SPECIAL STUFF
ATFFLG=32,1$, !SET WHILE THE COMMAND FILE IS OPEN
IGNSPC=31,1$, !WHEN SET, TTICHR WILL IGNORE SPACES
ENDIN=30,1$,
INMAIL=30,1$, !SET WHILE SENDING MAIL
TELBYE=29,1$, !SET UPON A BYE COMMAND, CLEARED ON A HOST COMMAND.
HASHF=28,1$, !WHEN SET, #'S WILL PRINT AFTER EACH NETWORK IO UUO.
DIOACT=27,1$, !SET UPON RECEIPT OF A 250, CLEARED BEFORE RETR&STOR'S, AND ON 252.
TELOPN=26,1$, !ON ON ! MODE (OPEN TELNET CHANNEL)
FILEOF=25,1$, !SET ON FILE END OF FILE.
DATEOF=24,1$, !SET ON DATA END OF FILE (NETWORK CHANNEL).
TTYORD=23,1$, !FLAG WHICH SAYS TTY OUPUT PENDING
VERBOSE=F<22,1>$, !SET IF WE WANT ALL MESSAGES THROUGH
BADPPN=F<21,1>$, !SET IF PPN IN ERROR, WHICH MAY NOT BE IMPORTANT
CMUSIT=F<20,1>$, !SET WHILE AT CMU
HSTMAIL=19,1$, !SET BY HOST TABLE LOOKUP IF HOST REQUIRES MAIL INSTEAD OF MLFL
REQ=18,1$; !SMLFL COMMAND NEEDS TO BE QUEUED
EXTERNAL
?.JBFF,
?.JBREN,
?.JBDDT,
?.JBSA,
?.JBINT;
bind
JOBFF=?.JBFF,
JOBSA=?.JBSA,
JOBDDT=?.JBDDT,
JOBREN=?.JBREN,
JOBINT=?.JBINT;
%THIS FILE CONTAINS SOME SIMPLE IO ROUTINES THAT OFTEN MAKE
LIFE EASIER. %
MACRO
ADDR=0,0$,
AC=23,4$,
INST=27,9$,
FADDR=0,23$,
RH=0,18$,
LH=18,18$,
WORD=0,36$,
DIGSIX(X)=( (X)+#20)$,
SIXASC(X)=((X)+#40)$,
ASC=36,7$,
ASZ=PLIT ASCIZ$,
SKIP(INSTT)=(SETO(VREG);INSTT;SETZ(VREG))$,
DEC(ADR)=(ADR←.ADR-1)$,
INC(ADR)=(ADR←.ADR+1)$,
IFE= IF 0 EQL$,
IFN= IF 0 NEQ$,
IFL= IF 0 GTR$,
IFLE=IF 0 GEQ$,
IFGE=IF 0 LEQ$,
IFF=IF 0 EQL$,
IFT=IF 0 NEQ$;
BIND
TRUE=-1,
FALSE=0;
MACHOP
CALL=#040,
TTCALL=#051,
IN=#056,
OUT=#057,
SETSTS=#060,
STATO=#061,
GETSTS=#062,
INBUF=#064,
OUTBUF=#65,
INPUT=#066,
OUTPUT=#067,
CLOSE=#070,
RELEASE=#071,
CALLI=#047,
USETI=#074,
USETO=#075,
!USEFUL OTHER INSTS:
MOVEI=#201,
JFCL=#255,
SETZ=#400,
SETO=#474,
XCT=#256;
BIND
PUSHJ=#260,
INIT=#050,! ACTUALLY A OPEN!
LOOKUP=#076,
RRENAME=#055,
ENTER=#077;
BIND WAITING=FALSE,
OKAY=TRUE,
TELABR=1↑18, !STORED IN MAXMES WHEN THE TELNET LINK BREAKS
ABORT=1; !NO, THIS IS NOT TRUE IN THIS PROGRAM
MACRO ISWAITING=EQL FALSE$, !(EQL 0)
DOABORT=GTR 0$,
ISOKAY=LSS 0$,
ISNOTOKAY=GEQ 0$;
ROUTINE WAIT(CHECK,TIME)=
% THIS ROUTINE WILL WAIT FOR UPTO TIME SECONDS, UNTIL THE CHECK ROUTINE
SAYS SOMETHING HAS HAPPENED (STATE ABORT OR OKAY). %
BEGIN
WHILE DEC(TIME) GEQ 0 DO BEGIN
IFT (.CHECK)() THEN RETURN .VREG; !TRUE IS NEQ FALSE, WHICH IS WAITING STATE.
! Make the SLEEP sleep: nail wake conditions with WAKE/HIBER pair;
vreg←-1; ifskip calli(vreg,#73) %WAKE% then .vreg else .vreg;
vreg←1; ifskip calli(vreg,#72) %HIBER% then .vreg else .vreg;
VREG←.SLPTIM;SLEEP(VREG);
END;
RETURN WAITING; !TIMEOUT..RETURN WAITING.
END;
ROUTINE SAVCHR(CH)=
BEGIN
REPLACEI(SAVPTR,.CH);
END;
GLOBAL ROUTINE TTOCHR(CH)=
% TTY OUTPUT ROUTINE. FORCES OUTPUT ON BUFFER FULL (ALMOST
NEVER) AND LINEFEED (TO MAKE LISTINGS UNDERSTANDABLE. %
BEGIN
IF DEC(TTOBHD[BHDCNT]) LEQ 0 THEN OUTPUT(TTOCHN);
REPLACEI(TTOBHD[BHDPNT],.CH);
if .CH eql "?J" and not .QNetEntry ! Output on buffer full only when TTOCHN=FTP.LOG
then Output(TTOCHN) else F<TTYORD>←true;
return .CH;
end;
MACRO
TTOSTR(STNG)=(F<RH>←(PLIT ASCIZ STNG)<ADDR>;TTOSTX())$,
TTOADR(ADR)=(F<RH>←ADR;TTOSTX())$;
GLOBAL ROUTINE STTOCHR(CH)=
begin
TTOCHR(.CH);
if inc(anscount) lss anscnt then REPLACEI(ANSWPT,.CH);
end;
GLOBAL ROUTINE TTOSTX=
% THE PARAMETER IS IN F<RH> AND IS THE ADDRESS OF AN ASCIZ STRING
WHICH WE SEND OFF TO TTOCHR BIT BY BIT. (BYTE BY BYTE?) %
BEGIN
REGISTER CH,PNT;
PNT←(.F<RH>)<ASC>;
UNTIL (CH←SCANI(PNT)) EQL 0 DO TTOCHR(.CH);
END;
MACRO
STTOSTR(STNG)=(F<RH>←(PLIT ASCIZ STNG)<ADDR>;STTOSTX())$,
STTOADR(ADR)=(F<RH>←ADR;STTOSTX())$;
ROUTINE STTOSTX=
% THE PARAMETER IS IN F<RH> AND IS THE ADDRESS OF AN ASCIZ STRING
WHICH WE SEND OFF TO TTOCHR BIT BY BIT. (BYTE BY BYTE?)
WE also append a copy in ANSWER %
BEGIN
REGISTER CH,PNT;
PNT←(.F<RH>)<ASC>;
UNTIL (CH←SCANI(PNT)) EQL 0 DO (TTOCHR(.CH);if inc(anscount) lss anscnt then REPLACEI(ANSWPT,.CH));
END;
MACRO
SAVSTR(STNG)=(F<RH>←(PLIT ASCIZ STNG)<ADDR>;SAVSTX())$,
SAVADR(ADR)=(F<RH>←ADR; SAVSTX())$;
ROUTINE SAVSTX=
BEGIN
REGISTER CH,PNT;
PNT←(.F<RH>)<ASC>;
UNTIL (CH←SCANI(PNT)) EQL 0 DO SAVCHR(.CH);
END;
FORWARD PTYMAIL;
FORWARD BYE,QUIT,CCLCLOSE;
routine GETLIN=
% This is called whenever TTICHR needs another buffer.
If more input is needed, it will read from the TTY if the
AT file isn't open, or the AT file if it is. Data from
the AT file is patched into the TTY buffers mainly for the
benefit of NEWLIN. Note that the AT file is echoed. %
begin
register R,CH;
F<CRLFIN>←false; LASTCH←0;
! if we're not reading from a file, just get a new buffer and leave
if not .F<ATFFLG> then (INPUT(TTICHN); return);
! otherwise patch the disk input to the tty buffers
TTIBHD[BHDPNT]←(R←(.TTIBHD[BHDBUF]+2)<ASC>);
TTIBHD[BHDCNT]←1;
do
begin
if DEC(ATFIBD[BHDCNT]) leq 0
then
ifskip IN(ATFCHN)
then
begin
F<ATFFLG>←false;
if .CCLEntry or .QNetEntry
then
begin
if .F<TELOPN> then (BYE(); QUIT(true));
CCLClose();
end
else INPUT(TTICHN);
return
end
else decr I from (.ATFIBD[BHDCNT]+4)/5 to 0
do
! deal with line numbers and the like
if .(.ATFIBD[BHDBUF]+2)[.I] ! not ascii bit on?
then
begin
if .(.ATFIBD[BHDBUF]+2)[.I] eql PGMARK
then
! for page marks, remove the next word, too
(.ATFIBD[BHDBUF]+2)[.I+1]←0;
(.ATFIBD[BHDBUF]+2)[.I]←0; !ERASE LINE #
(.ATFIBD[BHDBUF]+2)[.I+1]<29,7>←0; !ERASE TAB
end;
INC(TTIBHD[BHDCNT]);
CH←scani(ATFIBD[BHDPNT]);
if .ch neq 0
then
begin
replacei(r,.ch); ! copy over
if @EchoOff eql 0 ! want an echo?
then
ttochr(.ch) ! yes
end
end
until .ch eql "?J"; ! until eol
END;
ROUTINE TTICHR=
% TTY INPUT ROUTINE. IGNORES NULLS, HANDLES ↑Z CORRECTLY.
TO FORCE A NEW LINE ON NEXT CALL, USE THE NEWLIN MACRO,
WHICH SIMPLY CLEARS THE CHARACTER COUNT WORD. IT DOESN'T
KNOW IT, BUT IT ALSO HANDLES AT FILE INPUT. %
BEGIN
REGISTER CH;
IFN (CH←.LASTCH) THEN (LASTCH←0; RETURN .CH);
IF .F<CRLFIN> THEN RETURN -1;
IF .F<TTYORD> and not .QNETENTRY THEN (OUTPUT(TTOCHN);F<TTYORD>←0);
DO IF DEC(TTIBHD[BHDCNT]) LEQ 0 THEN GETLIN()
WHILE (CH←SCANI(TTIBHD[BHDPNT])) EQL 0 OR (IF .F<IGNSPC> THEN .CH EQL " " ELSE FALSE);
IF .CH EQL "Z"-#100 THEN CLOSE(TTICHN);
IF .CH EQL "M"-#100 THEN F<CRLFIN>←TRUE;
IF INC(CMDCOUNT) LSS CMDCNT THEN REPLACEI(CMDPNT,.CH);
RETURN .CH;
END;
ROUTINE SCNSPC=
% THIS WILL READ AND THROW OUT ANY PRECEDING SPACES BEFORE AN ALPHANUMERIC. %
BEGIN
DO (WHILE TTICHR() EQL " " DO) WHILE .VREG EQL "?I";
SAVECH(.VREG);
VEND;
ROUTINE INDEC=
% THIS ROUTINE EXPECTS TO BE POINTED AT THE START
OF A DECIMAL NUMBER AND SCANS UNTIL IT FINDS A NON-
DECIMAL CHARACTER. %
BEGIN
REGISTER CUM,CH;
CUM←0;
UNTIL (TTICHR();MOVEI(CH,-"0",VREG) GEQ 10)
DO CUM←.CUM*10+.CH;
![CFE] lastch ← @ch + "0"; ![96bit] remember where we are
TempCh ← (.CH + "0") and #177; ![CFE] Don't ruin scanning conventions!;
RETURN .CUM;
END;
routine InHost=
% [96bit]
routine to figure out from a decimal number which host he's talking
about.
%
begin
local hnum;
hnum ← indec(); ! get a number
![CFE] if (ttichr() neq ".") ! a period?
if .TempCh neq "." ! a period?
then
begin ! convert to new format
hnum<HostNumber> ← .hnum<6,2>; ! get host number
hnum<SiteNumber> ← .hnum<0,6>; ! get site number
end
else
begin
hnum<HostNumber> ← @hnum; ! store the host #
hnum<SiteNumber> ← InDec(); ! get and store site
![CFE] if ttichr() eql "." ! another?
if .TempCh eql "." ! another?
then
begin
ttostr('Don''t bother me with networks.?M?J');
InDec();
end;
end;
@hnum ! return the results
end;
ROUTINE OPEN(CHN,MODE,DEV,BUFS)=
BEGIN
REGISTER R;
R←(INIT↑4+.CHN)↑23+MODE<ADDR>;
SETO(VREG);XCT(0,R);SETZ(VREG);
VEND;
ROUTINE TYPOCT(NUM)=
% AN INEFICIENT IMPLEMENTATION OF THE OCTAL AND DECIMAL
NUMBER PRINTER ROUTINES. %
BEGIN
REGISTER R;
R←.NUM MOD 8+#60;
IF .NUM/8 NEQ 0 THEN TYPOCT(.NUM/8);
TTOCHR(.R);
END;
MACRO TTODEC(NUM)=GENDEC(NUM,TTOCHR<ADDR>)$,
STTODEC(NUM)=GENDEC(NUM,STTOCHR<ADDR>)$,
SAVDEC(NUM)=GENDEC(NUM,SAVCHR<ADDR>)$,
TEODEC(NUM)=GENDEC(NUM,TELOCH<ADDR>)$;
ROUTINE GENDEC(NUM,ROUT)=
BEGIN
REGISTER R;
R←.NUM MOD 10+#60;
IF .NUM/10 GTR 0 THEN GENDEC(.NUM/10,.ROUT);
(.ROUT)(.R);
END;
ROUTINE INSIX=
BEGIN
% THIS ROUTINE INPUTS AND RETURNS A SIXBIT NAME. IT IGNORES
SPACES, CTRL CHARS, LOWER CASE, CHARS AFTER THE SIXTH,
AND NEEDS A LF FOR A BREAK CHAR. %
REGISTER PNT,VAL,R;
VAL←0;
PNT←VAL<36,6>;
while true do begin
R←TTICHR(); if .R<6,1> then R<5,1>←0;
if .F<CRLFIN> then exitloop;
if .R lss "0" then exitloop;
if .R gtr "9" then if .R lss "A" then exitloop;
if .R gtr "Z" then exitloop;
if .PNT<30,6> neq 0 then replacei(PNT,.R-#40);
end;
SAVECH(.R); !REMEMBER LAST CHARACTER
RETURN .VAL;
END;
ROUTINE TYPSIX(WRD)=
% THIS PRINTS THE PASSED WORD AS SIXBIT, IGNORING NULLS
(SPACES). THE STOP CONDITION IS THE POSITION FIELD OF THE
BYTE POINTER BECOMING 0. %
BEGIN
REGISTER PNT;
PNT←WRD<36,6>;
DO (F<RH>←SCANI(PNT)+#40;IF .F<RH> NEQ #40 THEN TTOCHR(.F)) UNTIL .PNT<30,6> EQL 0;
END;
ROUTINE TTIOCT=
% READS AN OCTAL NUMBER FROM THE TTY. USED BY THE PPNPARSER. %
BEGIN
REGISTER OCT,CH;
OCT←0;
WHILE TRUE
DO IF (TTICHR();MOVEI(CH,-"0",VREG)) GEQ #10
THEN RETURN .OCT ELSE OCT←.OCT↑3+.CH;
END;
ROUTINE SCNPPN=
% THIS EXPECTS A PPN FROM THE TTY. IF THE FIRST CHAR IT SCANS IS
OCTAL (OR LESS) IT CALLS TTIOCT TO CALCULATE THE PPN (THUS)
ALLOWING THE ROUTINE TO BE USED BY ANY OTHER PDP-10).
OTHERWISE, IT AND THE NEXT 7 CHARACTERS ARE PUT INTO A TEMPORARY
AREA AND GIVEN TO THE CMUDEC UUO. THE PPN IS RETURNED IN LOC
PPN, AND THE ROUTINE RETURNS A TRUE/FALSE INDICATION OF
SUCCESS. %
BEGIN
REGISTER R;
IF (TTICHR();SAVECH(.VREG);.VREG) LEQ "7"
THEN (PPN←TTIOCT()↑18+TTIOCT();RETURN TRUE);
IF NOT .CMUSIT THEN RETURN FALSE;
R←CMUPPN<ASC>;
DECR I FROM 7 TO 0 DO REPLACEI(R,TTICHR());
IF (R←TTICHR()) NEQ "]" THEN SAVECH(.R); !ALLOW OPTIONAL ]
R←PPN<ADDR>↑18+CMUPPN<ADDR>;
SETO(VREG);CMUDEC(R);SETZ(VREG);
VEND;
ROUTINE SAVFILNAME=
BEGIN !CREATE TABLE OF 'QED' FILES TO BE DELETED
LOCAL COUNT;
INCR COUNT FROM 1 TO .FILCNT DO
IF .FILE EQL .FILNAMES[.COUNT] THEN RETURN;
IF .FILCNT LEQ FILLIMIT THEN
BEGIN
FILCNT←.FILCNT+1; FILNAMES[.FILCNT]←.FILE;
END;
END;
ROUTINE FILSCN=
% THIS SCANS THE TTY INPUT STREAM FOR A FILENAME OF
FORMAT 'DEV:FILE.EXT[PPN];'. DEV DEFAULTS TO DSK, FILE, EXT
AND PPN ALL DEFAULT TO 0. IT RETURNS A TRUE/FALSE INDICATION OF SUCCESS.
CURRENTLY, THE ONLY ERRORS IT CHECKS FOR ARE ILLEGAL
CHARACTERS AND BAD PPN'S. %
BEGIN
REGISTER WRD;
FILE←EXT←PPN←0;BADPPN←FALSE;
DEV←SIXBIT 'DSK';
FILPNT←.TTIBHD[BHDPNT]+7↑30;FILLEN←.TTIBHD[BHDCNT];
WHILE TRUE DO IF (WRD←INSIX();TEMP←TTICHR()) EQL ":"
THEN DEV←.WRD
ELSE IF .TEMP EQL "." THEN FILE←.WRD
ELSE (IF .TEMP EQL "["
THEN IFF SCNPPN() THEN RETURN(BADPPN←TRUE)
ELSE TEMP←TTICHR(); !NEED TO KNOW TERMINATOR
IF .TEMP EQL ";" OR .F<CRLFIN> OR .TEMP EQL "/"
THEN (IF .FILE NEQ 0 THEN EXT←.WRD ELSE FILE←.WRD;EXITLOOP)
ELSE RETURN FALSE);
FILLEN←.FILLEN-.TTIBHD[BHDCNT]; !CALC LENGTH OF PARSED STRING
SAVECH(.TEMP); !CALLER WILL NEED TERMINATOR
IF (.CCLENTRY OR .QNETENTRY) AND .EXT EQL SIXBIT 'QED' THEN SAVFILNAME();
RETURN TRUE;
END;
BIND
![96bit]NOWAIT=400000,
NoWait=#400000, ![96bit] close.....
Absolute=#100000, ![tcp] absolute socket, please
STATCD=0,
CONNCD=3,
CLOSCD=4,
LISTCD=5,
TALKCD=7,
PHSTCD=13,
WAITCD=17,
PCPCD=20,
RCPCD=21;
![96bit] BIND IMPCLL=IMPCAX;
![96bit] always use the new format UUO.
macro impcll(arg)=impinf( (arg) )$; ![96bit]
routine Num2Host(adr) =
begin
! Look up the host whose address is .Adr, and stick its information
! into RmtName/RmtNum/RmtSts. Just call upon NumHst interface
! routine, which calls HstNum in the ImpSub package.
local PtrS, PtrD, Char, Rslt;
if (Rslt ← NumHst(.Adr, PtrS<addr>, RmtNum<addr>, RmtSts<addr>)) neq HstOK
then
begin
RmtNum ← RmtSts ← 0;
return .Rslt
end;
decr Q from HNamSiz-1 to 0 do RmtName[.Q] ← 0;
PtrS<lh> ← (0<36,7>)↑(-18);
PtrD ← RmtName[0]<36,7>;
Cnt ← HNamSiz*5-1;
while (Cnt←.Cnt-1) geq 0 do
if replacei(PtrD,scani(PtrS)) eql 0 then exitloop;
return HstOK
end;
routine Nam2Host(namptr) =
begin
! Look up the host whose name is at .NamPtr, and stick its information
! into RmtName/RmtNum/RmtSts. Just call upon NamHst interface
! routine, which calls HstNam in the ImpSub package.
local PtrS, PtrD, Char, Rslt;
if (Rslt ← NamHst(.NamPtr, PtrS<addr>, RmtNum<addr>, RmtSts<addr>)) neq HstOK
then
begin
RmtNum ← RmtSts ← 0;
return .Rslt
end;
decr Q from HNamSiz-1 to 0 do RmtName[.Q] ← 0;
PtrS<lh> ← (0<36,7>)↑(-18);
PtrD ← RmtName[0]<36,7>;
Cnt ← HNamSiz*5-1;
while (Cnt←.Cnt-1) geq 0 do
if replacei(PtrD,scani(PtrS)) eql 0 then exitloop;
return HstOK
end;
ROUTINE HSTSCN=
% THIS SCANS THE TTY INPUT STREAM FOR A HOSTNAME OF FORMAT: SITE, SITE-HOST,
OR IDN, WHICH IT RETURNS IN NAMBLK[NTBSIT], NAMBLK[NTBHOS],
AND REMSIT. THE HOSTNAME MUST BE TERMINATED BY A ";" RETURNS TRUE
OR FALSE%
BEGIN local Ptr, Count, Char;
decr Q from HNamSiz-1 to 0 do RmtName[.Q] ← 0;
IF (SAVECH(TTICHR()); .VREG) LEQ "9"
THEN
begin
REMSIT←InHost(); ![CFE] Was INDEC();
decr Q from HNamSiz-1 to 0 do RmtName[.Q] ← 0;
RETURN TRUE
end;
Ptr ← RmtName[0]<36,7>;
Count ← HNamSiz*5-1;
while true do
begin
Char ← TTICHR();
if .Char eql ";" then return TRUE;
if .Char lss "-" then return FALSE;
if .Char gtr "-" then if .Char lss "0" then return FALSE;
if .Char gtr "9" then if .Char lss "A" then return FALSE;
if .Char gtr "Z" then if .Char lss "a" then return FALSE;
if .Char gtr "z" then return FALSE;
if (Count←.Count-1) geq 0 then replacei(Ptr,.Char);
end;
END;
ROUTINE FILNCH=
% ROUTINE TO PICK UP CHARS FROM FPO
FILE TO OUTPUT AS IF MAIL COMMAND %
BEGIN
REGISTER CH;
IF .F<CRLFIN> THEN (SCANI(XFRIBD[BHDPNT]);DEC(XFRIBD[BHDCNT]);F<CRLFIN>←FALSE);
DO IF DEC(XFRIBD[BHDCNT]) LEQ 0 THEN (IFSKIP IN(FILCHN) THEN
(CLOSE(FILCHN); RETURN CH←"Z"-#100))
WHILE (CH←SCANI(XFRIBD[BHDPNT])) EQL 0 OR (IF .F<IGNSPC> THEN .CH EQL " " ELSE FALSE);
IF .CH EQL "Z"-#100 THEN CLOSE(FILCHN);
IF .CH EQL "M"-#100 THEN (F<CRLFIN>←TRUE;SCANI(XFRIBD[BHDPNT]); DEC(XFRIBD[BHDCNT]));
RETURN .CH;
END;
ROUTINE QOUTCH(CH)=
BEGIN
IF DEC(QOBHD[BHDCNT]) LEQ 0 THEN OUTPUT(QCHN);
REPLACEI(QOBHD[BHDPNT],.CH);
IF .CH EQL "?J" THEN OUTPUT(QCHN);
RETURN .CH;
END;
MACRO
LISTEN(IB)=IMPCLL( (Absolute+LISTCD)↑18+(IB)<ADDR>)$,
CONNECT(IB,Bits)=IMPCLL( (Bits+CONNCD)↑18+(IB)<ADDR>)$,
CLOS(IB)=IMPCLL(CLOSCD↑18+(IB)<ADDR>)$,
FCLOS(IB)=IMPCLL((NOWAIT+CLOSCD)↑18+(IB)<ADDR>)$,
TALK(IB)=IMPCLL(TALKCD↑18+(IB)<ADDR>)$,
STATUS(IB)=(IFE (VREG←.IB[IMPIMP];DEVCHR(VREG))
THEN (IB[IMPLOG]←0) ELSE IMPCLL(STATCD↑18+(IB)<ADDR>))$,
PHST(IB)=IMPCLL(PHSTCD↑18+(IB)<ADDR>)$,
XWAIT(IB)=IMPCLL(WAITCD↑18+(IB)<ADDR>)$,
RCP(IB)=IMPCLL(RCPCD↑18+(IB)<ADDR>)$,
PCP(IB)=IMPCLL(PCPCD↑18+(IB)<ADDR>)$;
MACRO
GETCP(BYT)=(RCP(TELIBK);.TELIBK[IMPSTT]<BYT>)$,
SETCP(BYT,NEW)=(RCP(TELIBK);TELIBK[IMPSTT]<BYT>←NEW;PCP(TELIBK))$,
SNTBYT=7,8$,SNTTYP=0,7$;
ROUTINE TELIRD=
% THIS CAN BY USED WITH WAIT (ABOVE). ITS STATES ARE:
OKAY - WHEN THE TELNET LINK HAS INPUT READY
ABORT - WHEN THE TELNET LINK IS CLOSED
WAITING - NEITHER OF THE ABOVE. %
BEGIN
GETSTS(TELCHN,VREG);
IF .VREG<IODATA> THEN RETURN OKAY;
IFT CLOSCN(TELIBK) THEN RETURN ABORT;
RETURN WAITING;
END;
FORWARD CHKTEL; !*******
![tcp] RFCIN is an NCP relic.
![tcp]ROUTINE CONCHK=
![tcp]% MIGHT AS WELL PUT THE REST OF THEM HERE, TOO. THIS ONE WILL
![tcp] CHECK FOR A DATA CONNECTION BEING INITIATED, WITH THESE STATES:
![tcp] OKAY - WHEN SOCKET STATE GOES TO RFC IN
![tcp] ABORT - A SERVER MESSAGE IS PRECEDED WITH AN ERROR CODE
![tcp] WAITING - NEITHER OF THE ABOVE. %
![tcp] BEGIN
![tcp] REGISTER R;
![tcp] IFT RFCIN(DATBLK) THEN RETURN OKAY;
![tcp] IF (R←CHKTEL();.MAXMES) GEQ MINERR THEN RETURN .MAXMES; !WILL BE POSITIVE, OR ABORT
![tcp] RETURN WAITING;
![tcp] END;
ROUTINE DIOCHK=
% CHECKS TO SEE IF SERVER HAS GIVEN PERMISSION
TO TRANSFER. STATES:
OKAY - PERMISSION GRANTED OR STARTED
ABORT - SERVER GAVE UP BEFORE SENDING DATA
WAITING - NOT YET. %
BEGIN
CHKTEL(); !TAKE A LOOK AT ANY MSGS IN, HOPE FOR 250
RETURN IF .MAXMES GEQ MINERR THEN ABORT
ELSE IF .F<DIOACT> OR (GETSTS(DATCHN,VREG);.VREG<IODATA>)
THEN (F<DIOACT>←TRUE;OKAY) ELSE WAITING;
END;
ROUTINE ENDCHK=
% CHECKS TO SEE IF SERVER HAS ACKNOWLEDGED FILE TRANSFER
COMPLETE. STATES:
OKAY -RECIEVED THE 252 MESSAGE
ABORT -GOT AN ERROR MESSAGE
WAITING -NOTHING YET %
BEGIN
CHKTEL();
RETURN IF .MAXMES GEQ MINERR THEN ABORT
ELSE IF .F<ENDIN> THEN OKAY ELSE WAITING;
END;
ROUTINE TELCHK=
% THIS WILL LOOK FOR (AND PROCESS AT LEAST ONE RESPONSE FROM THE
THE TELNET LINK. STATES:
OKAY - FOUND ONE
ABORT - SERVER CLOSED TELNET LINKS
WAITING - NOT YET. %
BEGIN
IFGE CHKTEL() THEN RETURN IF .MAXMES EQL TELABR THEN ABORT ELSE OKAY;
RETURN WAITING;
END;
MACRO MSGCHK(MSGCOD)=(TEMP←MSGCOD;MSGCHECK<ADDR>)$;
ROUTINE MSGCHECK=
% THIS ROUTINE WILL WAIT UNTIL THE REQUESTED MSG OR ONE GREATER
ROLLS BY. %
RETURN IF TELCHK() ISOKAY THEN IF .MAXMES GEQ .TEMP THEN OKAY ELSE WAITING
ELSE .VREG;
![tcp] ICP is a thing of the past
!
!ROUTINE ICPINP=
!% THIS RETURNS THE SOCKET # SPECIFIED BY THE FOREIGN HOST. %
! BEGIN
! INPUT(ICPCHN);
! RETURN \(.ICPBHD[BHDPNT]+1)↑(-4);
! END;
!
ROUTINE TELICH=
% THIS RETURNS CHARACTERS FROM THE TELNET LINK UNTIL
THERE IS NO MORE INPUT, WHEN IT RETURNS 0. CHARACTERS 0-3
ARE IGNORED SINCE THEY ARE PROBABLY TELNET CONTROLS. %
BEGIN
DO IF DEC(TELIBD[BHDCNT]) LEQ 0 THEN IF (IF .LASCHR EQL "?J"
THEN TELIRD() ELSE WAIT(TELIRD<ADDR>,5)) ISOKAY
THEN INPUT(TELCHN) ELSE RETURN 0
UNTIL (VREG←SCANI(TELIBD[BHDPNT])) GEQ 3;
RETURN (LASCHR←.VREG);
END;
ROUTINE TELOCH(CH)=
% THIS OUTPUTS TO THE TELNET LINK, OUTPUTTING ON EITHER
BUFFER FULL OR LINEFEED (JUST LIKE TTOCHR). %
BEGIN
REGISTER R;
IF DEC(TELOBD[BHDCNT]) LEQ 0 THEN OUTPUT(TELCHN);
REPLACEI(TELOBD[BHDPNT],.CH);
IF .CH EQL "?J" THEN OUTPUT(TELCHN);
IF .JOBDDT neq 0 THEN (R←.CH;OUTCHR(R)); !FOR DEBUGGING
END;
ROUTINE TELSIX(WRD)=
% THIS ROUTINE SENDS THE SIXBIT WORD PASSED TO IT DOWN THE TELNET
LINK. %
BEGIN
REGISTER PNT;
PNT←WRD<36,6>;
UNTIL (.PNT AND #77↑30) EQL 0 DO BEGIN
IF (VREG←SCANI(PNT)) EQL 0 THEN RETURN .VREG;
TELOCH(.VREG+#40);
END;
VEND;
MACRO
TELSTR(STNG)=(F<RH>←(PLIT ASCIZ STNG)<ADDR>;TELSTX())$,
TELADR(ADR)=(F<RH>←ADR;TELSTX())$;
ROUTINE TELSTX=
% JUST LIKE TTOSTX, ONLY DIFFERENT. %
BEGIN
REGISTER CH,PNT;
PNT←(.F<RH>)<ASC>;
UNTIL (CH←SCANI(PNT)) EQL 0 DO TELOCH(.CH);
END;
ROUTINE TELLF=
% THIS COPIES CHARACTERS FROM TTY TO TELNET, STOPPING AFTER LINFEED. %
BEGIN
REGISTER CH;
IF .F<CRLFIN> THEN TELOCH("?M");
F<IGNSPC>←FALSE; !FOREIGN SIDE MAY WANT SPACES
UNTIL .F<CRLFIN> DO TELOCH(CH←TTICHR());
TELOCH("?J"); !NEEDED CAUSE TTICHR GIVES UP AFTER ?M
F<IGNSPC>←TRUE;NEWLIN; !ENSURE INPUT, FLAG BUFFER EMPTY. (SEE PASS)
END;
ROUTINE TELDEC=
% EXTRACTS A POSSIBLE DECIMAL # FROM THE TELNET MSG. %
BEGIN
OWN TELAST;
REGISTER CH,PNT;
PNT←TELMSG<ASC>;
CH←SCANI(PNT);
IF MOVEI(CH,-"0",CH) GTR 9 THEN RETURN .TELAST;
TELAST←(.CH*10+SCANI(PNT)-"0")*10+SCANI(PNT)-"0";
CONTMES←SCANI(PNT); !LOOK AHEAD AT NEXT CHAR FOR "-"
RETURN .TELAST;
END;
%**** SUPPRESS TELNET MESSAGE HANDLING PACKAGE ****%
% THEORY FOR THIS IS THAT WE HAVE A STACK OF PLITS OF MESSAGE CODES WE
DON'T WANT TO SEE. ALL THE PLITS ARE SEARCHED BY SUPCHK WHENEVER IT IS
PASSED A MSG CODE. IT WILL RETURN TRUE IF WE WANT TO SEE IT. NOTE THAT
SUPCHK GETS STUCK WITH THE TASK OF HANDLING VERBOSE MODE. %
OWN SUPCNT,SUPLST[10];
BIND SUPNORM=PLIT(200,230,231,252,253,254,255,256,330,331,350),
SUPINFO=PLIT 50;
MACRO
SUPREM=DEC(SUPCNT)$,
SUPINI=SUPCNT←-1$;
ROUTINE SUPMSG(LIST)=SUPLST[INC(SUPCNT)]←.LIST;
routine SupChk(MsgCod)=
begin
if .Verbose then return true;
if .CCLEntry or .QNetEntry then
begin
if .MsgCod eql 250 then return false;
if .MsgCod eql 252 then return true;
if .MsgCod eql 254 then return true;
if .MsgCod eql 256 then return true;
end;
decr I from .SupCnt to 0 do
decr J from .((.SupLst[.I])<word>)[-1]-1 TO 0 DO
if .MsgCod eql .((.SupLst[.I])<word>)[.J] then return false;
return true;
end;
routine TELCOM=
% READS A MESSAGE FROM THE TELNET AND PARSES THE MSG CODE,
PERFORMING SPECIAL ACTION ON THESE MESSAGES:
250 - MESSAGE THAT INDICATES IO IS IN PROGRESS, FLAGS THE
DIOACT BIT IN F.
252 - TURN OFF THE ABOVE BIT.
255 - THE SOCKET MESSAGE, PICKS UP THE PASSED SOCKET NUMBER THE
FOREIGN SITE WANTS US TO USE, AND PUTS IT IN DATSKT,
NEVER TO BE USED AGAIN, SINCE IT IS NOW PICKED UP BY THE
STATUS IMP CALL.
256 - SIGNIFIES THE SERVER HAS FOUND THE MAIL TERMINATER.
350 - SIGNIFIES THE SERVER IS NOW IN MAIL INPUT MODE. %
BEGIN
REGISTER R,CH;
SELECT R←TELDEC() of NSET
250: F<DIOACT>←TRUE;
252: F<ENDIN>←TRUE;
! 255: (DO TTOCHR(CH←TELICH()) UNTIL .CH EQL " ";
! DATSKT←TELDEC());
256: F<INMAIL>←FALSE;
350: F<INMAIL>←TRUE;
TESN;
RETURN .R
END;
ROUTINE CHKTEL=
% THIS PROCESSES ALL MESSAGES CURRENTLY ON THE TELNET LINK, AND
RETURNS THE CODE OF THE HIGHEST NUMBERED MESSAGE,
WHICH IS THE CODE OF THE MOST IMPORTANT ERROR.
**TELCNT AND TELPNT ARE INITIALIZED AT HOST CONNECT TIME** %
BEGIN
REGISTER R,CH;
R←-1;
WHILE TELIRD() OR .TELIBD[BHDCNT] GTR 1 DO BEGIN
IF (CH←TELICH()) EQL 0 THEN EXITLOOP;
IF DEC(TELCNT) GTR 0 THEN REPLACEI(TELPNT,.CH);
IF .CH EQL "?J" THEN BEGIN
REPLACEI(TELPNT,0);
R←TELCOM();
if .R geq 900 then if .R leq 999 then R←.R-900;
IFT SUPCHK(.R) THEN
BEGIN
IF .CONTMES eql "-" and not .MULTY
then
begin
MATCHMES←.R;
R←-1;
MULTY←TRUE;
end
else
if .MULTY and .MATCHMES eql .R
then
begin
MULTY←FALSE;
MATCHMES←-1
end;
STTOADR(TELMSG<ADDR>);
END;
IF .R GTR .MAXMES THEN MAXMES←.R;
TELPNT←TELMSG<ASC>; TELCNT←TELLEN;
END;
END;
TELIBK←.TELPHY; IF CLOSCN(TELIBK<ADDR>) THEN R←TELABR;
IF .R GTR .MAXMES THEN MAXMES←.R;
RETURN .R;
END;
ROUTINE DATCHK=
% CHECK DATA TRANSFER, COMPLAIN IF ERROR. %
BEGIN
IF .F<HASHF> THEN (TTOCHR("#"); OUTPUT(TTOCHN));
if .F<IOIMPM> then
begin
TTOSTR('??Data socket closed (foreign site crashed??)?M?J');
return true
end;
if .F<IOEOF> then return true;
ift .F and IOERR then
begin
TTOSTR('??New error from IMP system!?M?J');
return true
end;
return false;
end;
ROUTINE DATIN=
BEGIN
IF CHKTEL() GEQ MINERR THEN RETURN TRUE;
F<RH>←IFT SKIP(IN(DATCHN)) THEN (GETSTS(DATCHN,VREG);.VREG) ELSE 0;
RETURN DATCHK(); !CHECK TRANSFER, REPORT ERRORS
END;
routine DATOUT=
begin
if CHKTEL() geq MINERR then return true;
F<RH> ← ifskip OUT(DATCHN) then (GETSTS(DATCHN,VREG);.VREG) else 0;
return DATCHK();
end;
routine FILIN=
% This does INPUTs on the local file system, and reports
errors. It can't use F<RH> since TTOSTR does. %
begin
register IOSTS;
ifskip IN(FILCHN) then
begin
GETSTS(FILCHN,IOSTS);
if .IOSTS<IOEOF> then return true;
SETSTS(FILCHN,.IOSTS and not IOERR);
TTOSTR('%Input error, status: '); TYPOCT(.IOSTS);
TTOSTR(' -- continuing.?M?J');
end;
return false;
end;
routine FILOUT=
begin
register IOSTS;
ifskip OUT(FILCHN) then
begin
GETSTS(FILCHN,IOSTS);
SETSTS(FILCHN,.IOSTS and not IOALL);
TTOSTR('%Output error, status: '); TYPOCT(.IOSTS);
TTOSTR(' -- continuing.?M?J');
end;
return false;
end;
routine LOOK(CHN,FIL,EX,PROT,OWNER)=
begin
register R,R1;
R←(LOOKUP↑4+.CHN)↑23+FIL<ADDR>;
R1←SKIP(XCT(0,R));
IOWORDCOUNT←.OWNER/#1000000;
return .R1;
end;
bind BLTUUO=#251;
global EXTENDARG[27];
global routine XLOOK(CHANNEL,FILNAM,EXT,PPNADR,PROTADR)=
! Do an extended Lookup.
begin
register A;
bind LOOKUPUUO=#076;
EXTENDARG[0]←#25;
EXTENDARG[1]←..PPNADR;
EXTENDARG[2]←.FILNAM;
EXTENDARG[3]←.EXT;
EXTENDARG[4]←0;
A<LH>←EXTENDARG[4]; A<RH>←EXTENDARG[5];
EXECOP(BLTUUO,A,EXTENDARG[25]);
if EXECOP(LOOKUPUUO,.CHANNEL,EXTENDARG)
then
begin
.PROTADR←.EXTENDARG[4]<27,9>;
.PPNADR←.EXTENDARG[1];
return true
end;
return false
end;
routine ENT(CHN,FIL,EX,PROT,OWNER)=
begin
register R,R1;
R←(ENTER↑4+.CHN)↑23+FIL<ADDR>;
R1←SKIP(XCT(0,R));
IOWORDCOUNT←0;
return .R1;
end;
routine RENAM(CHN,FIL,EX,PROT,OWNER)=
begin
register R;
R←(RRENAME↑4+.CHN)↑23+FIL<ADDR>;
SKIP(XCT(0,R));
vend;
routine DELETEFIL(NAME,EXT)=
begin
if OPEN(FILCHN,#17,SIXBIT 'DSK',0) then
begin
if LOOK(FILCHN,.NAME,.EXT,0,.USRPPN) then
RENAM(FILCHN,.NAME,.EXT,#077↑27,.USRPPN); ! rename to a deletable protection
if LOOK(FILCHN,.NAME,.EXT,0,.USRPPN) then
RENAM(FILCHN,0,0,0,0); !now delete it
end;
end;
![tcp] remove old ICP code
!
!routine ICPERR(ERR)=
! begin
! register R;
! TTOCHR("??");
! TTOADR(case .ERR of set
! (ASZ 'Telnet listen failed (input)')<ASC>;
! (ASZ 'Telnet listen failed (output)')<ASC>;
! (ASZ 'ICP connection failed')<ASC>;
! (ASZ 'Telnet connection failed')<ASC>
! tes);
! TTOSTR('?M?J');
! FCLOS(TELIBK<ADDR>);
! if .ERR gtr 0 then begin
! FCLOS(TELOBK<ADDR>);
! if .ERR gtr 1 then
! begin
! FCLOS(ICPBLK<ADDR>);
! FCLOS(ICPBLK<ADDR>);
! release(TELCHN)
! end;
! end;
! vend;
!
!routine ICP(HOSTN,LCLSKT,ICPSKT)=
!% This performs the ICP protocol to any ICP socket at any host
! in the network. It calls to ICPERR to handle any error conditions
! that occur. %
! begin
! local SVJBFF; !MAINTAIN JOBFF OVER CALL
!
! SVJBFF←.JOBFF;
!
! TELIBK[IMPLCL]←.LCLSKT+3;
! TELIBK[IMPRMT]←0;
!![96bit] TELIBK[IMPHST]←#10↑18+.HOSTN;
! TELIBK[IMPHST]←.HOSTN; ![96bit] host in place
! TELIBK[IMPbyte]←#10↑18; ![96bit] byte size elsewhere
! ifge LISTEN(TELIBK<ADDR>) then (ICPERR(0); return -1);
!
! TELOBK[IMPIMP]←.TELIBK[IMPIMP];
! TELOBK[IMPLCL]←.LCLSKT+2;
! TELOBK[IMPHST]←.TELIBK[IMPHST];
! TELOBK[IMPRMT]←0;
! TELOBK[ImpByte]←.TELIBK[ImpByte]; ![96bit]
! ifge LISTEN(TELOBK<ADDR>) then (ICPERR(1); return -1);
! OPEN(TELCHN,AL,.TELLOG,TELOBD<ADDR>↑18+TELIBD<ADDR>);
!
!! ICPBLK[IMPIMP]←0;
! ICPBLK[IMPLCL]←.LCLSKT;
! ICPBLK[IMPRMT]←.ICPSKT;
!![96bit] ICPBLK[IMPHST]←32↑18+.HOSTN;
! ICPBLK[IMPHST]←.HOSTN; ![96bit] host
! ICPBLK[ImpByte]←32↑18; ![96bit] byte size
! ifge CONNECT(ICPBLK) then (ICPERR(2); return -1);
!
! OPEN(ICPCHN,6,.ICPBLK[IMPIMP],ICPBHD<ADDR>);
! INBUF(ICPCHN,1); ! All we need;
! TELIBK[IMPRMT]←ICPINP();
! TELOBK[IMPRMT]←.VREG+1;
! if not (CONNECT(TELIBK) and CONNECT(TELOBK))
! then (ICPERR(3); return -1);
! FCLOS(ICPBLK);
! ICPBLK[IMPIMP]←0;
! release(ICPCHN);
! JOBFF←.SVJBFF;
! return .TELIBK[IMPRMT];
! end;
!
![tcp] end of old ICP code
routine ICP(Hostn,LclPrt,RmtPrt)=
%[tcp]
this routine make a connection to a foriegn port
%
begin
TelIBk[ImpLcl] = @LclPrt; ! load local port
TelIBk[ImpRmt] = @RmtPrt; ! and remote port
TelIBk[ImpHst] = @Hostn; ! and host number
ifge Connect(TelIBk,0) ! try to connect
then
begin
ttostr('?? Connection failed.?M?J'); ! report error
FClos(TelIBk<addr>); ! close it
return -1
end;
LclSkt = @TelIBk[ ImpLcl ]; ! remember local socket
! open it up
Open(TelChn,AL,.Tellog,TelOBd<addr>↑18+TelIBd<addr>);
return 0; ! good return
end;
routine ACCT(PROMPT)=
% Here to send the account. %
begin
ift .PROMPT then (TTOSTR('Account: '); NEWLIN);
TELSTR('ACCT '); TELLF();
return true;
end;
routine PASS(PROMPT)=
% Format: 'PASS PASSWORD' %
begin
local OldEcho; ! place to save old echo value
register R;
R←-1; GETLCH(R);
ift .PROMPT then R<PRMFLG>←true;
if .F<CRLFIN> then R<PRMFLG>←true;
OldEcho ← @EchoOff; ! allow some flexibility, in case.
if .R<PRMFLG> then begin
NOECHO; !TURN OFF ECHO - WILL WORK ON IMP CONNECTIONS
!EVEN THOUGH THEY HAVE LCP SET
EchoOff ← -1; ! remember not to echo if a file
TTOSTR('Password: ');NEWLIN;
IF .R<TT2741> THEN TTOSTR('AAAAAA?H?H?H?H?H?HOOOOOO?H?H?H?H?H?HMMMMMM?H?H?H?H?H?HZZZZZZ?H?H?H?H?H?H')
ELSE IF .R<LCP> THEN TTOSTR('?M?JAAAAAA?MOOOOOO?MMMMMMM?MZZZZZZ?M')
ELSE R<NEC>←TRUE;
end;
TELSTR('PASS ');
TELLF();
EchoOff ← @OldEcho; ! restore internal echo to what it was
ECHO;
if .R<PRMFLG> then if .R<NEC> then TTOSTR('?M?J')
else if .R<LCP> then if not .R<TT2741> then TTOSTR('******?M?J');
WAIT(MSGCHK(230),10);
return if .MAXMES eql 331 then ACCT(TRUE) else false;
end;
routine USER=
% FORMAT: 'USER USAGE #' %
BEGIN
TELSTR('USER ');TELLF();
WAIT(MSGCHK(230),20); !WAIT FOR LOGIN (230), PSW (330), OR ERROR
RETURN IF .MAXMES EQL 330 THEN PASS(TRUE) ELSE FALSE; !FORCE PASSWORD IF NEEDED
END;
BIND ACRED=#5, !CHKACC ACCESS CODE FOR READING
SELF=6, !BIT POSITION DEFINITIONS FOR DECODING UFD PROTECTION
SAMEACCOUNT=3,
UFDPROTECTION=2,
FILEACCESS=1,
DIFFERENTACCOUNT=0,
SYSDEV=SIXBIT 'SYS',
MFDPPN=#1000001;
MACRO CHKACC(R)=(SKIP(CALLI(R,#100)))$;
OWN PROT;
ROUTINE SHOULDCHECKACCESS=
BEGIN
local MPPN,UFDPROT; !check ufd protection first
MPPN←MFDPPN;
if not OPEN(UFDCHN,#14,SYSDEV,UFDIBD<ADDR>) then return TRUE;
if not XLOOK(UFDCHN,.PPN,SIXBIT 'UFD',MPPN,UFDPROT) then return TRUE;
IF .PPN<RH> EQL .USRPPN<RH> THEN !SAME PERSON
BEGIN
RETURN
IF .ufdprot<SELF+UFDPROTECTION,1> THEN TRUE
ELSE .ufdprot<SELF+FILEACCESS,1>
END ELSE
IF .PPN<LH> EQL .USRPPN<LH> THEN !SAME ACCOUNT
BEGIN
RETURN
!FOR UFDS...IF BIT=1 >ACCESS OK
! =0 >NO ACCESS
IF .ufdprot<SAMEACCOUNT+UFDPROTECTION,1> THEN TRUE
ELSE .ufdprot<SAMEACCOUNT+FILEACCESS,1>
END ELSE
BEGIN !DIFFERENT ACCOUNT
RETURN
IF .ufdprot<DIFFERENTACCOUNT+UFDPROTECTION,1> THEN TRUE
ELSE .ufdprot<DIFFERENTACCOUNT+FILEACCESS,1>
END;
end;
ROUTINE DOCHECK=
begin
LOCAL E[3];
REGISTER R;
E[0]<LH>←ACRED;
E[0]<RH>←.PROT; !protection of file
IF .DEV EQL SIXBIT 'SYS' THEN PPN←#1000004;
E[1] ← if .PPN eql 0 then .USRPPN else .PPN;
E[2]←.USRPPN;
R←E<ADDR>;
RETURN if CHKACC(R) then not .R else FALSE;
end;
ROUTINE ACCESSALLOWED=
% CHECK THE USERS ACCESS TO THE FILE TO BE MAILED
RETURN TRUE IF ALLOWED ACCESS %
BEGIN
if not XLOOK(FILCHN,.FILE,.EXT,PPN,PROT) then return FALSE;
if SHOULDCHECKACCESS() THEN RETURN DOCHECK() else RETURN FALSE;
END;
ROUTINE INMONTH=
BEGIN
LOCAL MSTR;
MSTR←INSIX();SCNSPC();
RETURN
select (.MSTR and not #777777) of nset
sixbit 'JAN': exitselect 1;
sixbit 'FEB': exitselect 2;
sixbit 'MAR': exitselect 3;
sixbit 'APR': exitselect 4;
sixbit 'MAY': exitselect 5;
sixbit 'JUN': exitselect 6;
sixbit 'JUL': exitselect 7;
sixbit 'AUG': exitselect 8;
sixbit 'SEP': exitselect 9;
sixbit 'OCT': exitselect 10;
sixbit 'NOV': exitselect 11;
sixbit 'DEC': exitselect 12;
always: exitselect -1
tesn;
END;
ROUTINE DATESCAN(RESULT)=
% SCAN THE TIME STAMP AND COMPARE AGAINST TODAYS DATE. IF STAMP IS OLDER THAN
14 DAYS - PRINT ERROR MESSAGE AND SET TO DELETE FIL AND COMMAND AND RETURN FALSE %
BEGIN
LOCAL DAY,MON,YEAR,TIME,STAMPDATE;
REGISTER R;
STAMPDATE←DAY←MON←YEAR←TIME←0;
SCNSPC(); !SKIP OVER ANY SPACES IN SMLFL COMMAND STRING
IF SAVECH(TTICHR(); .VREG) EQL ";" THEN (LASTCH←0; RETURN TRUE); !NULL TIMESTAMP IS ALWAYS VALID
DAY←INDEC();
ScnSpc();
MON←INMONTH();
YEAR←INDEC();
if .YEAR lss 100 then YEAR ← .YEAR+1900;
INDEC(); SCNSPC(); INSIX(); SCNSPC();
IF SAVECH(TTICHR(); .VREG) EQL ";" THEN LASTCH←0;
STAMPDATE←((.YEAR-1964)*12+(.MON-1))*31+.DAY-1;
CALLI(R,#14);
IF (.R-.STAMPDATE) LEQ QTIMELIMIT THEN RETURN TRUE;
% THE TIME IN THE TIMESTAMP IS FOR THE USERS CONVENIENCE - ONLY THE DATE
IS USED IN DECIDING IF THE ENTRY HAS BEEN IN THE Q TOO LONG %
INSIX(); !ENTRY HAS BEEN IN Q MORE THAN 14 DAYS
FILSCN(); !SKIP OVER HOST NAME AND GET FILE NAME SO IT CAN BE DELETED
.RESULT ← .MON; !RETURN THE DAY SO WE CAN CHECK TO SEE IF MAYBE NO STAMP GIVEN
return false;
end;
ROUTINE OUTTIME(TIME)=
BEGIN
LOCAL MINS;
SAVDEC(.TIME/60);
MINS←.TIME MOD 60;
IF .MINS GTR 9
THEN SAVDEC(.MINS)
ELSE ( SAVCHR("0"); SAVCHR(.MINS+"0"));
END;
OWN ZONE;
ROUTINE GETZONE(DAYOFWEEK,DAY,MONTH)=
BEGIN
LOCAL LASTDAY,LASTSATURDAY;
IF .MONTH LSS 3 THEN (ZONE←PLIT ASCIZ '-EST'; RETURN);
IF .MONTH GTR 3 AND .MONTH LSS 9 THEN (ZONE←PLIT ASCIZ '-EDT';RETURN);
IF .MONTH GTR 9 THEN (ZONE←PLIT ASCIZ '-EST'; RETURN);
IF .MONTH EQL 3 THEN LASTDAY←30 ELSE LASTDAY←31;
LASTSATURDAY←6-.DAYOFWEEK+.DAY;
IF .LASTSATURDAY GTR .LASTDAY THEN LASTSATURDAY←.LASTSATURDAY-7;
IF .MONTH EQL 3 THEN (ZONE← IF .DAY LEQ .LASTSATURDAY THEN PLIT ASCIZ '-EST' ELSE
PLIT ASCIZ '-EDT'; RETURN);
ZONE←IF .DAY LEQ .LASTSATURDAY THEN PLIT ASCIZ '-EDT' ELSE PLIT ASCIZ '-EST';
END;
GLOBAL ROUTINE TIMENTRY=
BEGIN
LOCAL DAY,MONTH,YEAR,M,Y,C,YA,DAYOFWEEK;
LOCAL DECDATE;
MACRO T(TXT)=ASCIZ 'TXT'$;
DECDATE←DATE;
DAY←.DECDATE MOD 31+1;
MONTH←(.DECDATE/31) MOD 12;
YEAR←.DECDATE/(12*31)+1964;
IF .MONTH GTR 1
THEN BEGIN
M←.MONTH-2;
Y←.YEAR;
END
ELSE BEGIN
M←.MONTH+10;
Y←.YEAR-1;
END;
C←.Y/100;
YA←.Y-100*.C;
DAYOFWEEK←((146097*.C)/4+(1461*.YA)/4+(153*.M+2)/5+.DAY+2) MOD 7;
GETZONE(.DAYOFWEEK,.DAY,.MONTH);
SAVDEC(.DAY);
SAVCHR(" ");
SAVADR(PLIT(
T(Jan),
T(Feb),
T(Mar),
T(Apr),
T(May),
T(Jun),
T(Jul),
T(Aug),
T(Sep),
T(Oct),
T(Nov),
T(Dec)
)[.MONTH]);
SAVCHR(" ");
SAVDEC(.YEAR);
SAVCHR(" ");
BEGIN
LOCAL TIME;REGISTER R;
MSTIME(R);
TIME←.R/(60*1000);
OUTTIME(.TIME)
END;
SAVADR(.ZONE);
SAVCHR("");
RETURN TRUE;
END;
routine OPENLOG=
% opens FTP.LOG file on TTOCHN and sets up EFILE block so ICP error
messages get put in LOG file. Also opens FTP.Q file for requeueing
Both FTP.LOG and FTP.Q are opened in update mode to insure no one else
can access them during this run. If FTP.Q doesn't exist it looks for
FTP.Q1 on the same channel and uses it. If both .Q and .Q1 exist
OPENLOG appends the Q1 file to the Q file and deletes Q1 and frees it up to
be used as an overflow file in the case some other job wants to Q
something for this user while QNET has FTP.Q locked up.
If FTP.LOG or FTP.Q can't be accessed, return false and schedule this user later.
If neither FTP.Q or FTP.Q1 exist, give user a message and don't reschedule.
%
begin
Macro RESCHEDULE=(DOQUEUE←TRUE;RETURN FALSE)$;
bind RBSIZ=5;
local PROT,HIBLOCK,CHAR;
FILXCT←(PUSHJ)↑27+(#17)↑23+O1BYTE<ADDR>;
FILCHAN←TTOCHN;
FILDEV←SIXBIT 'DSK';
FILHDP<LH>←TTOBHD;
FILNAM←SIXBIT 'FTP';
FILEXT←SIXBIT 'LOG';
FILPPN←.USRPPN;
EFILE←FILBLK<ADDR>;
!get FTP.LOG
!IF CAN'T LOCK FILE THEN RESCHEDULE
OPEN(TTOCHN,AL,.FILDEV,TTOBHD<ADDR>↑18+TMPBHD<ADDR>);
EXTENDARG[RBSIZ]←0;
XLOOK(TTOCHN,sixbit 'FTP',sixbit 'LOG',FILPPN,PROT) ;
iff ENT(TTOCHN,SIXBIT 'FTP',SIXBIT 'LOG',#177↑27,.USRPPN) THEN RESCHEDULE;
INBUF(TTOCHN,1);OUTPUT(TTOCHN);
!if FTP.LOG already exists set up to continue
if .EXTENDARG[RBSIZ] gtr 0 then !writing where left off (to prevent partially written blocks)
begin
HIBLOCK←(.EXTENDARG[RBSIZ]+#177)/#200;
USETO(TTOCHN,.HIBLOCK); !read last block written
IN(TTOCHN);
while ((CHAR←scani(TMPBHD[BHDPNT])) neq 0
and dec(TMPBHD[BHDCNT]) geq 0)
do (dec(TTOBHD[BHDCNT]); REPLACEI(TTOBHD[BHDPNT],.CHAR));
USETO(TTOCHN,.HIBLOCK); !set pointer to rewrite last block when buffer full
end;
SAVPTR←STRP(TIMSTRNG);
TTOSTR('?M?J------------------------?I?I');
TIMENTRY(); !writes date/time in log and saves a copy to be used by PTYMESSAGE
TTOADR(TIMSTRNG);
TTOSTR('?M?J');
OPEN(ATFCHN,AL,SIXBIT 'DSK',ATFOBD↑18+ATFIBD<ADDR>);
IF LOOK(ATFCHN,SIXBIT 'FTP',SIXBIT 'Q1',0,.USRPPN) THEN !IF Q1
IF ENT(ATFCHN,SIXBIT 'FTP',SIXBIT 'Q1',0,.USRPPN) THEN !AND CAN LOCK IT
BEGIN
OPEN(QCHN,AL,SIXBIT 'DSK',TMPBHD<ADDR>↑18);
IF LOOK(QCHN,SIXBIT 'FTP',SIXBIT 'Q',0,.USRPPN) THEN !THEN IF Q
BEGIN
IF ENT(QCHN,SIXBIT 'FTP',SIXBIT 'Q',0,.USRPPN) THEN !AND CAN LOCK IT
begin !then append Q1 to Q
USETI(QCHN,-1); !go to bottom of ftp.q
INBUF(ATFCHN,1); OUTPUT(QCHN);
ifskip IN(ATFCHN)
then .vreg
else
while (dec(ATFIBD[BHDCNT]) geq 0)
do replacei(TMPBHD[BHDPNT],scani(ATFIBD[BHDPNT]));
OUTPUT(QCHN);CLOSE(QCHN);
RENAM(ATFCHN,0,0,0,0);
END
END ELSE RENAM(ATFCHN,SIXBIT 'FTP',SIXBIT 'Q',#277↑27,0);!ELSE IF NO Q RENAME Q1 TO Q
END; !ELSE IF NO Q1 DO NOTHING
!NOW LOCK UP NEW FTP.Q ON QCHN
!AND SET UP TO READ OLD FTP.Q ON QTFCHN
!AND GET STARTED
OPEN(QCHN,AL,SIXBIT 'DSK',QOBHD<ADDR>↑18);
IFF ENT(QCHN,SIXBIT 'FTP',SIXBIT 'Q',0,.USRPPN) THEN RESCHEDULE;
OUTPUT(QCHN);
OPEN(ATFCHN,AL,SIXBIT 'DSK',ATFIBD<ADDR>);
IFF LOOK(ATFCHN,SIXBIT 'FTP',SIXBIT 'Q',0,.USRPPN) THEN
BEGIN
TTOSTR('????No FTP.Q file found?M?J');
CLOSE(TTOCHN);
CLOSE(QCHN,100);
DOQUEUE←FALSE; RETURN FALSE;
END;
INBUF(ATFCHN,1);
F<ATFFLG>←TRUE;
return TRUE;
end;
ROUTINE COPYTOQ=
% ROUTINE TO COPY MAIL TMP FILE TO EITHER FTP.Q OR Q1 %
BEGIN
MACRO TELLUSER=TTOSTR('?I?I?I?I **Commands queued**?M?J')$;
REGISTER ACC; LOCAL COUNT;
FILE← SIXBIT ' FTP';
PJOB(ACC);
FILE<30,6>←DIGSIX(.ACC/100);
FILE<24,6>←DIGSIX((.ACC/10) MOD 10);
FILE<18,6>←DIGSIX(.ACC MOD 10);
IFF OPEN(ATFCHN,AL,SIXBIT 'DSK',ATFOBD<ADDR>↑18+ATFIBD<ADDR>) THEN
(TTOSTR('????Cannot open DSK to copy mail tmp file to FTP.Q?M?J');RETURN);
IFF LOOK(ATFCHN,.FILE,SIXBIT 'TMP',0,.USRPPN) THEN (TTOSTR('????Cannot find mail tmp file?M?J');RETURN);
IFF OPEN(QCHN,AL,SIXBIT 'DSK',TMPBHD<ADDR>↑18) THEN
(TTOSTR('????Cannot open dsk to copy mail tmp file to FTP.Q?M?J');RETURN);
IF LOOK(QCHN,SIXBIT 'FTP',SIXBIT 'Q',0,.USRPPN) THEN
BEGIN
IFF ENT(QCHN,SIXBIT 'FTP',SIXBIT 'Q',0,.USRPPN) THEN
BEGIN
IFF LOOK(QCHN,SIXBIT 'FTP',SIXBIT 'Q1',0,.USRPPN) THEN
(RENAM(ATFCHN,SIXBIT 'FTP',SIXBIT 'Q1',#277↑27,0);TELLUSER; RETURN);
COUNT←0;
WHILE 0 EQL ENT(QCHN,SIXBIT 'FTP',SIXBIT 'Q1',0,.USRPPN)DO
BEGIN
COUNT←COUNT+1;
ACC←#10; SLEEP(ACC);
IF .COUNT EQL 10 THEN (TTOSTR('????Cannot copy mail tmp file to either FTP.Q or FTP.Q1!!?M?J');RETURN);
END;
END;
USETI(QCHN,-1); !go to bottom of ftp.q
INBUF(ATFCHN,1); OUTPUT(QCHN);
ifskip IN(ATFCHN)
then .vreg
else
while (dec(ATFIBD[BHDCNT]) geq 0)
do replacei(TMPBHD[BHDPNT],scani(ATFIBD[BHDPNT]));
OUTPUT(QCHN);CLOSE(QCHN);
RENAM(ATFCHN,0,0,0,0);
TELLUSER;
END ELSE (RENAM(ATFCHN,SIXBIT 'FTP',SIXBIT 'Q',#277↑27,0); TELLUSER);
END;
ROUTINE CMDLF(CMD)=
% THIS ROUTINE WILL HANDLE THE TRIVIAL TYPE SERVER CMDS. %
BEGIN
TELSIX(.CMD AND -1↑12); !HACK TO LET COMMAND NAME BE MORE THAN 4 CHARS LONG.
TELOCH(" ");
TELLF();
RETURN TRUE; !EXPECT A REPLY
END;
ROUTINE STAT=
BEGIN
IF .F<CRLFIN> THEN BEGIN !GIVE VERBOSE AND HASH STATUS IF THAT SORT
IF .VERBOSE THEN TTOSTR('Verbose flag set.?M?J');
IF .F<HASHF> THEN TTOSTR('Hash flag set.?M?J');
END;
IF .F<TELOPN> THEN BEGIN
TELSTR('STAT ');TELLF();
WAIT(TELCHK<ADDR>,5);
IF .MAXMES LSS LSTCMDOK THEN UNTIL WAIT(TELCHK<ADDR>,2) ISNOTOKAY DO;
END;
RETURN FALSE;
END;
ROUTINE HELP=
% THIS SHOULD TELL THE USER SOMETHING USEFUL. %
BEGIN
REGISTER CNT;
IF .F<TELOPN> THEN BEGIN
TTOSTR('Server help:?M?J');
TELSTR('HELP ');TELLF();
WAIT(TELCHK<ADDR>,5);
IF .MAXMES LSS MINERR THEN UNTIL WAIT(TELCHK<ADDR>,2) ISNOTOKAY DO;
END;
TTOSTR('Commands currently available in both * and ! mode:?M?J');
CNT←0;
INCR I FROM 1 TO .COMTAB[-1]-1 DO BEGIN
IF .I EQL FIRTEL THEN
(TTOSTR('?M?JCommands available only in ! mode:?M?J');CNT←0);
TYPSIX(.COMTAB[.I]);
IF INC(CNT) GEQ 9 THEN (TTOSTR('?M?J');CNT←0) ELSE TTOCHR("?I");
END;
TTOSTR('?M?JFor more information do a ''HELP FTP'' command in monitor mode.?M?J');
RETURN FALSE;
END;
ROUTINE MAILID(CHROUT)=
% THIS WILL TRANSMIT A ONE LINE MAIL HEADER VIA THE CHROUT ROUTINE
THAT WAS PASSED AS A PARAMETER. INCLUDED IN THE LINE ARE BOTH THE
JOB'S PPN AND NAME. %
BEGIN
REGISTER R,PNT,ROUT;
LOCAL COUNT;
MACRO PUTSTR(STR)=(PNT←(STR)<ASC>;MAISTR())$;
ROUTINE MAISTR=
UNTIL (R←SCANI(PNT)) EQL 0 DO (.ROUT)(.R);
MACRO PUTCHR(CHAR)=(.ROUT)(CHAR)$;
MACRO PUTOCT(NUM)=(PNT←NUM;MAIOCT())$;
ROUTINE MAIOCT=
BEGIN
REGISTER R1;
R1←.PNT MOD 8;
IF (PNT←.PNT/8) NEQ 0 THEN MAIOCT();
PUTCHR(.R1+"0");
END;
END;
ROUTINE SETSAV=
BEGIN
LOCAL COUNT;
IF .CCLENTRY OR .QNETENTRY THEN
if .EXT eql sixbit 'QED' then !save name from deletion only if 'QED' extension
BEGIN
INCR COUNT FROM 1 TO .FSAVCNT DO
IF .FILE EQL .FILSAV[.COUNT] THEN RETURN;
IF .FSAVCNT LEQ FILLIMIT THEN
BEGIN
FSAVCNT←.FSAVCNT+1;
FILSAV[.FSAVCNT]←.FILE;
END;
END;
END;
ROUTINE MAIL=
% THIS WILL SEND MAIL TO ANYONE ON THE NET. %
BEGIN
MACRO MERROR=(
if .MAXMES eql 450 or (.MAXMES geq 500 and .MaxMes leq 599)
then
begin
SETSAV(); F<REQ>←false; F<MESSAGE>←TRUE; return TRUE;
end
else
if .MAXMES %eql 454% geq 400 then
(F<REQ>←TRUE; SETSAV(); RETURN TRUE);
RETURN TRUE)$,
MEND(COND)=IF .R COND THEN (TTOSTR('?M?J'); TELSTR('?M?J.?M?J');
WAIT(MSGCHK(256),30); MERROR;)$;
REGISTER R;
F<INMAIL>←FALSE;
TELSTR('MAIL ');TELLF();F<IGNSPC>←FALSE;
WAIT(MSGCHK(350),15); !LET SERVER TRY TO STARTUP MAIL
IF NOT .F<INMAIL> THEN RETURN FALSE;
TTOSTR('Enter mail, end with <escape>.?M?J');
DO BEGIN
IF (IF .F<ATFFLG> THEN TRUE ELSE 0 NEQ SKIP(SKIPNL)) THEN BEGIN
UNTIL .F<CRLFIN> DO BEGIN
R←TTICHR();
MEND(EQL "?Z");
MEND(EQL #33);
TELOCH(.R);
END;
TELOCH("?J");NEWLIN;
END;
R←#20↑18+1000; IFF SKIP(HIBER(R)) THEN (R←1; SLEEP(R));
CHKTEL();
END
WHILE .F<INMAIL>;
END;
BIND NOSTORE=1↑35;
ROUTINE BYTE(SIZE)=
% THIS ROUTINE SETS UP BYTE SIZES IN AND SENDS THE
APPROPRIATE CMD IF NECESSARY. %
BEGIN
![tcp] only 8 bit bytes
!
! TEMP←.SIZE<RH>; !IGNORE LH, WHICH MEANS OTHER STUFF
! IF .TEMP GEQ 256 THEN (TTOSTR('??Byte size too big.?M?J'); RETURN FALSE);
! IF .TEMP NEQ 8 THEN IF .TEMP NEQ 32 THEN IF .TEMP NEQ 36
! THEN (TTOSTR('??Unimplemented byte size.?M?J'); RETURN FALSE);
! IF .F<TELOPN> THEN IF GETCP(SNTBYT) NEQ .TEMP THEN BEGIN
! TELSTR('BYTE ');TEODEC(.TEMP);TELSTR('?M?J');
! WAIT(TELCHK<ADDR>,5);
! IF .MAXMES GEQ MINERR THEN RETURN FALSE;
! SETCP(SNTBYT,.TEMP);
! END;
! IFGE .SIZE THEN BEGIN
! CURBYT←.TEMP;
! IF .CURTYP NEQ "A" THEN USEBYT←.CURBYT;
! END;
!
![tcp] end of obsolete code
RETURN FALSE;
END;
ROUTINE TYPE(CHR)=
BEGIN
![tcp] we understand no types
!
! IF .CHR<6,1> THEN CHR<5,1>←0; !CVT LOWER CASE TO UPPER
! TEMP←.CHR<RH>;
! IF .TEMP EQL A THEN TEMP←"A"
! ELSE IF .TEMP EQL IMG THEN TEMP←"I"
! ELSE IF (.TEMP NEQ "A") AND (.TEMP NEQ "I")
! THEN (TTOSTR('??Illegal argument to TYPE.?M?J');RETURN FALSE);
! IF .F<TELOPN> THEN IF GETCP(SNTTYP) NEQ .TEMP THEN BEGIN
! TELSTR('TYPE ');TELOCH(.TEMP);TELSTR('?M?J');
! WAIT(TELCHK<ADDR>,5);
! IF .MAXMES GEQ MINERR THEN RETURN FALSE;
! SETCP(SNTTYP,.TEMP);
! END;
! IFGE .CHR THEN BEGIN
! CURTYP←.TEMP;
! USEBYT←IF .TEMP EQL "A" THEN ASCBYT ELSE IMGBYT;
! IOMODE←IF .TEMP EQL "A" THEN A ELSE IMG;
! END;
!
![tcp] end of obsolete code
RETURN FALSE;
END;
OWN REUSE;
ROUTINE HOST(SCANNAME)=
% FORMAT: 'HOST <DECIMAL HOST #>' OR 'HOST <NICKNAME>'
THIS OPENS A CONNECTION TO A HOST, AND ASKS CMU-CMU
USERS WHETHER OR NOT THEY WANT TO LOGIN TO THE OTHER SITE. %
BEGIN
REGISTER R;
REUSE←FALSE;
TELIBK[IMPIMP]←.TELLOG;TELIBK[IMPLCL]←0; !FLAG INPUT SKT
IF .SCANNAME THEN
BEGIN
RemSit ← 0;
IF .F<CRLFIN> THEN
IFL(STATUS(TELIBK<ADDR>))
THEN
![96bit] .TELIBK[IMPHST]<RH>
RemSit ← .TelIbk[ImpHst] ![96bit] return full host number
ELSE (TTOSTR('??No connection on that socket.?M?J');F<REQ>←true;RETURN FALSE)
ELSE IF (SAVECH(TTICHR());.VREG) LEQ "9"
THEN
![96bit] INDEC()
RemSit ← InHost() ![96bit] get the host from the tty
ELSE
BEGIN
HstScn();
if (Temp←Nam2Host(RmtName[0]<0,0>)) eql HstNoTable then
begin
ttostr('??Host table unreadable -- please use decimal addresses instead.?M?J');
F<REQ> ← true;
return false;
end;
if .Temp neq HstOK then
begin
ttostr('??Host ');
ttoadr(RmtName[0]);
if .Temp eql HstNoHost
then ttostr(' not in host table.?M?J')
else ttostr(' ambiguous.?M?J');
return False;
end;
RemSit ← .RmtNum;
END;
IF .F<TELOPN> THEN QUIT(TRUE);
MAXMES←-1; !HACK TO IGNORE WHAT PREVIOUS LAST SAID
END;
TELIBK[IMPIMP]←.TELLOG; TELIBK[IMPLCL]←0;
IFL STATUS(TELIBK<ADDR>) THEN BEGIN
![96bit]IF .TELIBK[IMPHST]<RH> NEQ .REMSIT
IF .TELIBK[IMPHST] NEQ .REMSIT ![96bit] full host
THEN BEGIN
TTOCHR("??");
![96bit] NAMBLK[NTBADR]←.TELIBK[IMOHST]<RH>;
if Num2Host(.TelIBk[ImpHst]) eql HstOK
then
begin
ttoadr(RmtName[0]);
END ELSE begin
TTOSTR('Host ');
![96bit] TTODEC(.TELIBK[IMPHST]<RH>)
ttodec(.telibk[ImpHst]<16,8>); ![96bit] host
ttostr('.'); ![96bit] .
ttodec(.telibk[ImpHst]<0,16>); ![96bit] imp
end;
TTOSTR(' already connected to that socket.?M?J');
F<REQ>←true;
RETURN FALSE;
END;
IF PJOB(R) NEQ .TELIBK[IMPERR]<LH> THEN
(TTOSTR('??That socket is in use by another job.?M?J');F<REQ>←true;RETURN FALSE);
TTOSTR('Reusing existing connection.?M?J'); REUSE←TRUE;
LclSkt = @TelIBk[ ImpLcl ]; ! get our local socket
![tcp] TELOBK[IMPIMP]←.TELLOG;TELOBK[IMPLCL]←-1;STATUS(TELOBK<ADDR>); !ENOUGH DATA FOR IMPUUO'S.
OPEN(TELCHN,AL,.TELLOG,TELOBD<ADDR>↑18+TELIBD<ADDR>);
F<TELOPN>←TRUE; !USE THIS AS TEMP FLAG TO ADVOID DEFAULTS
END
ELSE
IFL (
![tcp] REMSKT←
ICP(.REMSIT,.LCLSKT,.ICPSKT))
THEN (F<REQ>←true; F<TELOPN>←false; RETURN FALSE);
!!!!! STILL IN ROUTINE HOST !!!!!
TELPNT←TELMSG<ASC>;TELCNT←TELLEN; !INITIALIZE TELNET MSG HANDLER
DATSKT←.R+4; !INIT DEFAULT DATA SOCKET (SEND&RETR HANDLE GENDER)
TELPHY←(R←.TELIBK[IMPIMP]; ifskip DEVNAM(R) then .R else .R);
F<CMULNK>←FALSE;
![96bit] IF (.REMSIT AND #77) EQL #16
if .remsit<SiteNumber> eql CMUsite then
if .RemSit<HostNumber> neq #3 then ![CFE] magic for no 3/14 yet;
ifn .cmusit
then F<CMULNK>←true;
INBUF(TELCHN,2);OUTBUF(TELCHN,2);
F<TELBYE>←FALSE; !WE HAVEN'T DONE A BYE YET.
IF .F<TELOPN> and .REUSE THEN RETURN FALSE; !THIS IS SET EARLY ON A REUSE.
F<TELOPN>←TRUE; !ENTER EXCLAMATION MARK MODE
IF NOT .F<CMULNK> THEN RETURN TRUE;
IF NOT .SCANNAME THEN RETURN TRUE; !DON'T LOGIN IF SMLFL COMMAND
TTOSTR('Want to Login?? (Y or CR): ');NEWLIN;
R←TTICHR(); IF .R<6,1> THEN R<5,1>←0;
WAIT(TELCHK<ADDR>,10);
IF .R EQL "Y" THEN BEGIN
!!!! IF .F<CMULNK> THEN BEGIN
CMUPPN[2]←GETPPN(R); !SEND A USER CMD IF CMU-CMU
R←CMUPPN[2]<ADDR>↑18+CMUPPN<ADDR>;
IFF SKIP(DECCMU(R)) THEN RETURN FALSE;
TELSTR('USER ');
TELADR(CMUPPN<ADDR>);TELSTR('?M?J');
MAXMES←0; !MUST ZERO IN CASE WE CALLED QUIT
WAIT(MSGCHK(230),20); !FAKE A USER CMD-LIKE WAIT
RETURN IF .MAXMES EQL 330 THEN PASS(TRUE) ELSE FALSE;
!!!! END;
END;
RETURN FALSE;
END;
ROUTINE FUNFIL(STOFLG)=
% THIS ROUTINE IS AND INTERFACE TO THE FILE SCANNER AND THE NETWORK.
IT WILL TAKE A FILE XFER CMD AND HANDLE ALL THE DEFAULTING.
CMD FORMS (FOR AN ARBITRARY CMD, SAY X, ARE:
X DEV:FILE.EXT[PPN]<CR>
GENERATES: IF A STORE, THEN LCL FILE: DEV:FILE.EXT[PPN], AND
FOREIGN FILE FILE.EXT.
IF A RETR, THEN THE LCL AND FOREIGN NAMES ARE REVERSED.
X DEV:FILE.EXT[PPN]/[P,P]
GENERATES: LOCAL FILE DEV:FILE.EXT[PPN], AND
FOREIGN FILE FILE.EXT.
X PATH1;PATH2
GENERATES LOCAL FILE PATH1, FOREIGN FILE PATH2.
%
BEGIN
IF .F<CRLFIN> THEN BEGIN
IFL .STOFLG THEN (CNT←"/"; EXITCOMPOUND [2]);
DECR I FROM .FILLEN TO 1 DO TELOCH(SCANI(FILPNT));
TELSTR('?M?J');
RETURN;
END;
IF .CNT EQL "/" THEN BEGIN
TELSIX(.FILE);TELOCH(".");TELSIX(.EXT);
END;
IF .F<CRLFIN> THEN TELSTR('?M?J') ELSE TELLF();
END;
ROUTINE MLFLCH(CH)=
% THIS WILL BE CALLED BY MAILID TO STORE ITS OUTPUT STREAM. %
BEGIN
IFL DEC(XFROBD[BHDCNT]) THEN DATOUT();
REPLACEI(XFROBD[BHDPNT],.CH);
END;
ROUTINE XFRFIL(STOFLG,BYTSIZ,TRNTYP,RETRY)=
BEGIN
REGISTER WRD;
LOCAL CHAR;
Label DoTransfer;
XFRJBF←.JOBFF;
IF NOT .RETRY THEN
BEGIN
IF .F<CRLFIN> THEN (TTOSTR('Filename;Pathname '); NEWLIN);
IFF FILSCN() THEN (TTOSTR('??Cannot parse filname?M?J'); RETURN FALSE);
CNT←TTICHR(); !GET FILE BREAK CHAR
IF .F<CRLFIN>
THEN IFGE .STOFLG THEN (DEV←SIXBIT 'DSK'; PPN←0; BADPPN←FALSE); !A RETR <CR> TYPE ALWAYS TO DSK
IF .BADPPN THEN (TTOSTR('??PPN unparseable.?M?J'); RETURN FALSE);
WRD←TTICHN; TEMP←(DEVNAM(WRD);SETZ(WRD));
WRD←.DEV; IF (DEVNAM(WRD); SETO(WRD)) EQL .TEMP
THEN (TTOSTR('??TTY files not yet implemented.?M?J');RETURN FALSE);
END;
IF .QNETENTRY and .PPN eql 0 THEN PPN←.USRPPN;
IFF OPEN(FILCHN,.TRNTYP,.DEV,(IFL .STOFLG THEN XFRIBD<ADDR> ELSE XFROBD<ADDR>↑18))
THEN (TTOSTR('??Cannot open device?M?J'); RETURN FALSE);
IFF (IFL .STOFLG THEN LOOK<ADDR> ELSE ENT<ADDR>)(FILCHN,.FILE,.EXT,0,.PPN)
THEN (TTOCHR("??");TYPOCT(.EXT<RH>);TTOSTR(' error from LOOKUP/ENTER?M?J');RETURN FALSE);
IF .CCLENTRY or .QNETENTRY then if NOT ACCESSALLOWED() THEN (TTOSTR('??Protection error?M?J'); SETSAV(); RETURN FALSE);
DoTransfer:
BEGIN !another compound
DATBLK[IMPIMP]←0;
![tcp] DATBLK[IMPLCL]←(WRD←.LCLSKT+4; IFL .STOFLG THEN INC(WRD); .WRD);
DatBlk[ImpLcl] = .LclSkt; ![tcp] use the right local port
![96bit] DATBLK[IMPHST]←.BYTSIZ↑18+.TELIBK[IMPHST]<RH>;
DATBLK[IMPHST]←.TELIBK[IMPHST]; ![96bit] host number
![tcp] DATBLK[ImpByte]←.BYTSIZ↑18; ![96bit] byte size
![tcp] DATBLK[IMPRMT]←0;
DatBlk[ImpRmt] = @IcpSkt - 1; ![tcp] specify correct remote port
F<DIOACT>←FALSE;F<ENDIN>←FALSE;
SUPMSG(SUPINFO); !SUPPRESS LOGIN GARBAGE IF WE GET A FREE LOGIN
IFGE LISTEN(DATBLK<ADDR>) ! do a listen for the data con.
THEN
Leave DoTransfer; ! get out on failure (error printed.)
![tcp] BYTE(NOSTORE+.BYTSIZ); TYPE(NOSTORE+.TRNTYP);
!If unexpected error code....give error
IF .MAXMES GTR MINERR
THEN
begin
STTOSTR('??Reply code=');
STTODEC(.MAXMES);
STTOSTR('?M?J');
UNTIL .F<CRLFIN> do TTICHR();
Clos(DatBlk<Addr>); ! get rid of the socket
Leave DoTransfer; ! and leave the area
end;
![tcp] IF (WRD←.TRNTYP) EQL IMG THEN IF .BYTSIZ EQL 8 THEN WRD←2
![tcp] ELSE IF .BYTSIZ EQL 32 THEN WRD←3;
wrd = @TrnTyp; ![tcp] set data mode
OPEN(DATCHN,.WRD,.DATBLK[IMPIMP],IFL .STOFLG THEN XFROBD<ADDR>↑18 ELSE XFRIBD<ADDR>);
![tcp] IF .TRNTYP EQL IMG THEN BEGIN
![tcp] XFRIBD[BHDPNT]<24,6>←.BYTSIZ; !STORE SAME SIZE BYTES IN FILE
![tcp] XFROBD[BHDPNT]<24,6>←.BYTSIZ;
![tcp] END;
TELSIX(.COMTAB[.STOFLG] AND -1↑12);TELOCH(" ");
FUNFIL(.STOFLG); !HANDLE THE FUNNY FILE STUFF including mailee name if MLFL
![tcp] no longer have to do a connect: connection is always duplex.
![tcp] IF WAIT(CONCHK<ADDR>,30) ISNOTOKAY
![tcp] THEN
![tcp] begin
![tcp] CLOSE(DATCHN,#40);
![tcp] Clos(DatBlk<Addr>); ! free the socket for next time
![tcp] Leave DoTransfer; ! and get out
![tcp] end;
![tcp] IFGE CONNECT(DATBLK<ADDR>,Absolute)
![tcp] THEN
![tcp] begin
![tcp] CLOSE(DATCHN,#40);
![tcp] Clos(DatBlk<Addr>); ! free the socket for next time
![tcp] Leave DoTransfer; ! and get out
![tcp] end;
IF WAIT(DIOCHK<ADDR>,30) ISNOTOKAY THEN
begin
IF .VREG ISWAITING
THEN
TTOSTR('??XFRFIL - Timeout waiting to start transfer.?M?J');
CLOSE(DATCHN,#40);
Clos(DatBlk<Addr>); ! free the socket for next time
Leave DoTransfer; ! and get out
end;
CNT←0;TIME←MSTIME(VREG);
F<DATEOF>←FALSE;
TEMP←IFL .STOFLG
THEN (INBUF(FILCHN,4); OUTBUF(DATCHN,4); FILIN<ADDR>↑18+DATOUT<ADDR>)
ELSE (OUTBUF(FILCHN,4); INBUF(DATCHN,4); DATIN<ADDR>↑18+FILOUT<ADDR>);
IF .STOFLG<RH> EQL MLFLCMD THEN MAILID(MLFLCH<ADDR>);
WHILE TRUE DO BEGIN
IFLE DEC(XFRIBD[BHDCNT]) THEN IFT (.TEMP<LH>)() THEN EXITLOOP;
CHAR←SCANI(XFRIBD[BHDPNT]);
!STRIP NULLS IF MLFL CMD
if .STOFLG<RH> eql MLFLCMD
then
begin
if .CHAR neq 0 then
begin
IFLE DEC(XFROBD[BHDCNT])
THEN
IFT (.TEMP<RH>)()
THEN EXITLOOP;
REPLACEI(XFROBD[BHDPNT],.CHAR)
end
end
else
begin
IFLE DEC(XFROBD[BHDCNT])
THEN
IFT (.TEMP<RH>)()
THEN EXITLOOP;
REPLACEI(XFROBD[BHDPNT],.CHAR)
end;
INC(CNT);
END;
IF (TIME←MSTIME(VREG)-.TIME) LSS 0 THEN TIME←.TIME+24*60*60*1000;
TEMP←(.CNT*.BYTSIZ*10+500)/.TIME; !100-BAUDS, ROUNDED TO NEAREST
IF NOT .CCLENTRY then if NOT .QNETENTRY THEN BEGIN TTODEC(.CNT); TTOSTR(' bytes, '); TTODEC(.TEMP/10);
TTOCHR("."); TTOCHR(.TEMP MOD 10+"0"); TTOSTR(' KBD?M?J'); END;
CLOSE(DATCHN);
CLOS(DATBLK<ADDR>);
RELEASE(DATCHN);
IF (WRD←WAIT(ENDCHK<ADDR>,40)) ISWAITING
THEN
begin
STTOSTR('%Server slow on transfer done acknowledgement - assume complete.?M?J');
SETSAV(); F<REQ> ← true;
end
ELSE IF .WRD DOABORT THEN F<DIOACT>←FALSE; !TRY TO FORGET WE DID ANYTHING
end; !compound statement
IF .F<DIOACT> THEN CLOSE(FILCHN)
ELSE (CLOSE(FILCHN,#40);STTOSTR('??Transfer aborted.?M?J');
F<REQ>←TRUE;SETSAV(););
IF .MAXMES eql 450 or (.MAXMES GEQ 500 and .MaxMes leq 599)
then
BEGIN
SETSAV(); F<REQ>←false; F<MESSAGE>←TRUE;
END
else
IF .MAXMES %EQL 454% geq 400 THEN (F<REQ>←TRUE; SETSAV());
RELEASE(FILCHN);
JOBFF←.XFRJBF;
RETURN FALSE;
END;
ROUTINE ATFILE=
% THIS INITIALIZES THE AT FILE, TTICHR WILL READ FROM IT UNTIL
EOF COMES ALONG. %
BEGIN
REGISTER ACC;
IF NOT .CCLENTRY THEN
BEGIN
IFF FILSCN() THEN (TTOSTR('??Bad filename.?M?J'); RETURN FALSE);
IF .BADPPN THEN (TTOSTR('??PPN unparseable.?M?J'); RETURN FALSE);
IF .EXT EQL 0 THEN EXT←SIXBIT 'CMD'; !DEFAULT EXTENSION
END else
BEGIN
FILE← SIXBIT ' FTP';
PJOB(ACC);
FILE<30,6>←DIGSIX(.ACC/100);
FILE<24,6>←DIGSIX((.ACC/10) MOD 10);
FILE<18,6>←DIGSIX(.ACC MOD 10);
EXT← SIXBIT 'TMP';
DEV←SIXBIT 'ALL';
CCLFIL←.FILE;
END;
IFF OPEN(ATFCHN,1,.DEV,ATFIBD<ADDR>) THEN (TTOSTR('??OPEN failed.?M?J'); RETURN FALSE);
IFF LOOK(ATFCHN,.FILE,.EXT,0,.USRPPN) THEN (TTOSTR('??LOOKUP failed.?M?J'); RETURN FALSE);
INBUF(ATFCHN,1);
F<ATFFLG>←TRUE;
RETURN FALSE;
END;
ROUTINE TELLQNET=
BEGIN
REGISTER R;
FILE←GETPPN(R);
EXT←SIXBIT 'QED ';
DEV←SIXBIT 'SSL';
PPN←#3↑18+#3;
IF OPEN(TMPCHN,#17,.DEV,0) THEN
IFF LOOK(TMPCHN,.FILE,.EXT,0,.PPN) THEN
begin
IF ENT(TMPCHN,.FILE,.EXT,0,.PPN) THEN CLOSE(TMPCHN) else
TTOSTR('??Could not ENTER FTP.Q request in [3,3] queue?M?J');
end;
END;
ROUTINE CCLCLOSE=
BEGIN
LOCAL COUNT,COUNT2,DELF;
BIND RESDV=117;
REGISTER R;
DELETEFIL(.CCLFIL,SIXBIT 'TMP');
INCR COUNT FROM 1 TO .FILCNT DO !DELETE FPO.QED FILES
BEGIN
DELF←TRUE;
INCR COUNT2 FROM 1 TO .FSAVCNT DO
IF .FILNAMES[.COUNT] EQL .FILSAV[.COUNT2] THEN DELF←FALSE;
IF .DELF THEN DELETEFIL(.FILNAMES[.COUNT],SIXBIT 'QED');
END;
if .QNETENTRY then !DELETE OLD FTP.Q FILE
begin
close(ATFCHN);renam(ATFCHN,0,0,0,0);
end;
IF .DOQUEUE AND .CCLENTRY THEN TELLQNET();
IF .QNETENTRY THEN (TTOSTR('?M?J'); EFILE←0; CLOSE(TTOCHN));
IF .QNETENTRY AND NOT .DOQUEUE THEN RENAM(QCHN,0,0,0,0) ELSE RELEASE(QCHN);
STOP(1);
END;
ROUTINE BYE=
(TELSTR('BYE ?M?J');F<TELBYE>←TRUE;SUPMSG(SUPINFO);RETURN TRUE);
ROUTINE QUIT(DOBYE)=
% THIS PERFORMS 2 FUNCTIONS: IN ! MODE, IT BREAKS
THE TELNET CONNECTIONS, AND IN * MODE, IT EXITS
TO THE MONITOR. %
BEGIN
IF .F<TELOPN> THEN BEGIN
IFT .DOBYE THEN IF NOT .F<TELBYE> THEN (BYE(); WAIT(TELCHK<ADDR>,5));
CLOSE(TELCHN);
IF NOT .F<ATFFLG> THEN JOBFF←.HSTJBF; !RECLAIM BUFFER SPACE
F<TELOPN>←FALSE;
%THE NEXT LINE IS A KLUDGE TO ENSURE WE GET A REAL DEV, OR ELSE
CLOS MAY COMPLAIN, IF THE THE CLOS INT (LIKE FROM TENEX) BEATS US. %
TELIBK[IMPIMP]←.TELPHY;
CLOS(TELIBK<ADDR>);
![tcp] TELOBK[IMPIMP]←.TELPHY;
![tcp] CLOS(TELOBK<ADDR>);
RELEASE(TELCHN);
END ELSE STOP(1);
END;
ROUTINE RENAME=
% THIS ROUTINE TAKES 2 LINES AS ARGUMENTS. 1ST THE OLD FILE NAME,
THEN THE NEW NAME. %
BEGIN
TELSTR('RNFR ');TELLF();
WAIT(TELCHK<ADDR>,5);
IF .MAXMES GEQ MINERR THEN RETURN FALSE; !GIVE UP IF IT DOESN'T LIKE US
TTOSTR('Rename to: ');TELSTR('RNTO ');TELLF();
MAXMES←-1;WAIT(MSGCHK(253),10);
RETURN FALSE;
END;
ROUTINE DELETE=
BEGIN
TELSTR('DELE ');TELLF();
WAIT(MSGCHK(254),10);
RETURN FALSE;
END;
ROUTINE SMAIL(RETRY)=
% ROUTINE OPENS UP THE FPO FILE AND SIMULATES A MAIL RATHER THAN MLFL
COMMAND %
BEGIN
MACRO MERROR=(
if .MAXMES eql 450 or (.MAXMES geq 500 and .MaxMes leq 599)
then
begin
SETSAV(); F<REQ>←FALSE; F<MESSAGE>←TRUE;
return TRUE;
end
else
if .MAXMES %eql 454% geq 400 then (F<REQ>←TRUE; SETSAV(); RETURN TRUE);
RETURN TRUE)$,
MEND(COND)=IF .R COND THEN (TTOSTR('?M?J'); TELSTR('?M?J.?M?J');
WAIT(MSGCHK(256),30); MERROR;)$;
REGISTER R;
F<INMAIL>←FALSE;
IF NOT .RETRY THEN
BEGIN
IFF FILSCN() THEN (TTOSTR('??Cannot parse filename?M?J'); RETURN FALSE);
IF .PPN EQL 0 THEN PPN←.USRPPN;
IFF OPEN(FILCHN,1,.DEV,XFRIBD<ADDR>) THEN (TTOSTR ('??Cannot open device?M?J'); RETURN FALSE);
IFF LOOK(FILCHN,.FILE,.EXT,0,.PPN) THEN (TTOSTR('??LOOKUP error?M?J'); RETURN FALSE);
IF NOT ACCESSALLOWED() THEN RETURN FALSE;
INBUF(FILCHN,1);
R←TTICHR(); !GET RID OF THE BREAK CHAR(;)
END;
TELSTR('MAIL ');
R←TTICHR();
if .R eql -1 or .R eql 15 then
begin
TTOSTR('??No username specified?M?J');
return false;
end;
LASTCH←.R; TELLF(); F<IGNSPC>←FALSE; !SCAN PATHNAME AND PASS ALONG
if WAIT(MSGCHK(350),30) ISWAITING then
begin
TTOSTR('??Server slow in MAIL transfer go ahead acknowledgement.?M?J');
SETSAV();
F<REQ> ← true;
return false
end;
if .MAXMES gtr 350 then MERROR;
if not .F<INMAIL> then (SETSAV(); F<REQ>←true; return false);
do begin
until .F<CRLFIN> do begin
R←FILNCH();
MEND( EQL "?Z");
MEND( EQL #33);
TELOCH(.R);
end;
TELOCH("?J"); F<CRLFIN>←FALSE; !GET NEXT LINE
R←20↑18+1000;
ifskip Hiber(R) then .vreg else (R ← 1; sleep(R));
CHKTEL();
end
while .F<INMAIL>;
end;
forward PTYMESSAGE;
routine SMLFL=
! Routine to execute a Super MLFL command.
! This is the only FTP command that QNET will process from FTP.Q.
! Format: SMLFL DATESTAMP;HOSTNAME;FILNAME;PATHNAME
begin
local Result,SavATF;
register R;
macro QYES=true$,
QNO =false$,
SCANREST(DOQ)=begin if FILSCN() then SETSAV();
F<IGNSPC>←false;
F<REQ>←DOQ;
until .F<CRLFIN> do TTICHR(); vreg←false end$;
F<REQ>←false;
if not DATESCAN(RESULT) then
begin
if .RESULT eql -1
then STTOSTR('?M?J???I?I?I?I?I**No time stamp: ')
else
begin
STTOSTR('?M?J???I?I?I?I?I**Outdated command: ');
HSTSCN()
end;
if .QNETENTRY then STTOSTR(' Removed from queue**?M?J')
else STTOSTR('?M?J');
SCANREST(QNO);
PTYMESSAGE();
return false;
end;
F<IGNSPC>←true;
REMSIT←-1;
REUSE←false;
if HSTSCN() then ! If host name can be scanned, look it up in table.
begin
if .RemSit gtr 0
then ! was numeric;
begin
if Num2Host(.RemSit) neq HstOK
then RmtNum ← .RemSit; ! Error recovery;
end
else ! was a name--evaluate it;
begin
if (Temp ← Nam2Host(RmtName[0]<addr>)) eql HstNoTable then
begin
ttostr('??Host table unreadable!?M?J');
return ScanRest(QYes)
end;
if .Temp neq HstOK then
begin
ttostr('??Host ');
ttoadr(RmtName[0]);
if .Temp eql HstNoHost
then ttostr(' not in host table?M?J')
else ttostr(' ambiguous?M?J');
return ScanRest(QNo)
end;
end;
if .RmtNum eql .BadHost then
begin
TTOSTR('??Same host as above, so assume same error?M?J');
return SCANREST(QYES)
end;
if .RemSit eql -1 then RemSit ← .RmtNum;
if .RmtNum eql .LclNum then return PtyMail();
if .NCPDOWN then
begin
TTOSTR('?M?JNCP not running.?M?J');
SCANREST(QYES);
return false
end;
! Given a valid host name...try to make a connection.
ifl STATUS(TELIBK<ADDR>) then ! If host connected on this channel,
begin
![96bit] IF .TELIBK[IMPHST]<RH> NEQ .REMSIT THEN !AND NOT SAME AS NEW HOST
if .TELIBK[IMPHST] neq .REMSIT then ! and not same as new host,
begin ! Close existing connection and open new one
if .F<TELOPN> then Quit(true); ! Be nice, do a BYE;
Result ← Host(false);
end
else Result ← false;
end
else Result ← Host(false);
if not .F<TELOPN> or STATUS(TELIBK<ADDR>) geq 0 then !If no connection can be made, requeue and exit
begin
BadHost ← .RmtNum;
return SCANREST(QYES);
end;
end
else
begin
until .F<CRLFIN> do TTICHR();
TTOSTR('??Error scanning host name?M?J');
return false
end;
! If a connection was made (Result=true) wait for host to respond (300...)
! If reusing an existing connection (ReUse=true) then there is no need to wait for a response.
if not .REUSE then
ift .RESULT then
begin
!![CFE] if WAIT(MSGCHK(300),30) ISWAITING THEN
own WaitRslt;
MaxMes ← 0;
WaitRslt ← WAIT(MSGCHK(300),40);
if (.WaitRslt IsNotOkay) or (.MaxMes neq 300) then
begin
TTOSTR('%Server slow on startup acknowledgement.?M?J');
Quit(.MaxMes gtr 0); ![CFE]
return SCANREST(QYES);
end;
end
else TELCHK();
if .MAXMES eql 504 then return SCANREST(QYES);
ift .RESULT and not .REUSE then !if not already logged in and
if .RmtSts<2,1> then ! Special (Multics) host...pass special USER/PASS commands;
begin
MAXMES←-1;
TELSTR('USER NETML?M?J');
WAIT(MSGCHK(230),30); ! wait for login(230), PSW(330)
if .MAXMES eql 330 then
begin
MAXMES←-1;
TELSTR('PASS NETML?M?J');
!![CFE] if WAIT(MSGCHK(230),30) ISWAITING then
if WAIT(MSGCHK(230),30) IsNotOkay then ![CFE]
(TTOSTR('%Server slow in accepting USER command.?M?J'); return SCANREST(QYES));
if .MAXMES gtr 330 then
(TTOSTR('??Error in USER command?M?J'); return SCANREST(QYES));
end;
end;
MAXMES←-1;
Result ← if .RmtSts<3,1>
then SMAIL(false) else XFRFIL(true↑18+MLFLcmd,ascbyt,A,false);
return .RESULT;
end;
ROUTINE REQUEUE=
% APPENDS SMLFL COMMAND WHICH FAILED TO FTP.Q SO THAT IT WILL BE QUEUED
IF CCLENTRY TO FTP - REQUEUE OPENS FTP.Q AND APPENDS THE COMMAND TO THE END OF THE FILE.
IF QNETENTRY TO SFTP - REQUEUE JUST APPENDS THE COMMAND TO THE FTP.Q FILE ALREADY OPEN
ON QCHN %
BEGIN
REGISTER PNT,CH;
LOCAL HIBLOCK,PROT;
BIND RBSIZ=5;
!ALSO IF HOST'S NOQ BIT IS SET
if .RmtSts<0,2> eql 3 %is a TIP% then
BEGIN
STTOSTR('???? **Do not issue mail to this host**?M?J');
PTYMESSAGE();
TTOSTR('?I?I?I?I **Not queued**?M?J');
RETURN FALSE;
END;
if .F<MESSAGE> then
begin
PTYMESSAGE();
if not .F<REQ> then (TTOSTR('?I?I?I?I?I**Not queued**?M?J'));
end;
if not .F<REQ> then RETURN;
DOQUEUE←true;
if .TTIBHD[BHDCNT] neq 0 then until .F<CRLFIN> do TTICHR(); !SCAN REST OF SMLFL COMMAND
NEWLIN;
if not .QNETENTRY then !if from ccl open ftp.q and position to end of data
begin
local dummy;
iff OPEN(QCHN,1,SIXBIT 'DSK',QIBHD<ADDR>+QOBHD<ADDR>↑18) then
(TTOSTR('??Cannot open device to queue command?M?J'); RETURN);
EXTENDARG[RBSIZ]←0;
XLOOK(QCHN,SIXBIT 'FTP',SIXBIT 'Q',USRPPN,PROT);
iff ENT(QCHN,SIXBIT 'FTP',SIXBIT 'Q',0,.USRPPN) then
begin
iff OPEN(QCHN,1,SIXBIT 'DSK',QIBHD<ADDR>+QOBHD<ADDR>↑18) then
(TTOSTR('??Cannot open device to queue command?M?J'); RETURN);
EXTENDARG[RBSIZ]←0;
XLOOK(QCHN,SIXBIT 'FTP',SIXBIT 'Q1',USRPPN,PROT);
PNT←10;
while .PNT gtr 0 do iff ENT(QCHN,SIXBIT 'FTP',SIXBIT 'Q1',0,.USRPPN)
then (DEC(PNT); CH←5; SLEEP(CH)) else exitblock;
TTOSTR('??Cannot enter FTP.Q?M?J'); return;
end;
INBUF(QCHN,1); OUTPUT(QCHN);
if .EXTENDARG[RBSIZ] gtr 0 then
begin
local CHAR;
HIBLOCK←(.EXTENDARG[RBSIZ]+#177)/#200;
USETO(QCHN,.HIBLOCK);
IN(QCHN);
while ((CHAR←scani(QIBHD[BHDPNT])) neq 0
and DEC(QIBHD[BHDCNT]) geq 0)
do (DEC(QOBHD[BHDCNT]); replacei(QOBHD[BHDPNT],.CHAR));
USETO(QCHN,.HIBLOCK);
end;
end;
PNT←CMDBUF<ASC>;
while (CH←scani(PNT)) neq "?M" and .CH neq 0 do QOUTCH(.CH);
if .CH neq 0 then QOUTCH(.CH);
QOUTCH("?J");
if not .QNETENTRY then CLOSE(QCHN);
if not .QNETENTRY and not .CCLENTRY then TELLQNET(); !ENTER REQUEST IN QNET Q
TTOSTR('?I?I?I?I --Command queued--?M?J');
end;
routine ICPSET(SKT)=
(if .SKT then ICPSKT←.SKT else TTOSTR('The ICP socket must be odd.?M?J'); return false);
routine LCLSET(SKT)=
% THIS ROUTINE WILL SET A NEW LCLSKT #, AND GENERATE A NEW LOGICAL
NAME TO USE. IT USES IDPB'S BECAUSE BLISS FORGETS ACCUMULATOR STATES
AFTER REPLACEI'S. %
begin
machop IDPB=#136;
register R,T1;
R←.SKT;
if .R geq #1000 then (TTOSTR('??Socket number too big.?M?J'); return false);
LCLSKT←.R; !REMEMBER FOR FUTURE USE
TELLOG←sixbit 'FTP'; !FIRST HALF WILL BE 'FTP'
T1←TELLOG<18,6>; !MODIFY LOGICAL NAME
VREG←.R/#100+#20; idpb(VREG,T1);
VREG←(R←.R mod #100)/#10+#20; idpb(VREG,T1);
replacei(T1,.R mod #10 +#20);
return false;
end;
routine XPATCH=
begin
TALK(TELIBK<ADDR>);
XWAIT(TELIBK<ADDR>);
TTOSTR('?M?J');
return false;
end;
routine DDT=
% THIS WILL CALL DDT IF IT IS LOADED. %
begin
if .JOBDDT<RH> neq 0 then (.JOBDDT<RH>)() else TTOSTR('??DDT not loaded?M?J');
return false;
end;
routine HASH=
% THIS COMPLEMENTS THE VALUE OF THE HASH SWITCH WHICH PRINTS
HASHES EVERY BUFFER TRANSFERRED. %
if F<HASHF>←not .F<HASHF> then TTOSTR('Now you see ''em?M?J')
else TTOSTR('Now you don''t?M?J');
routine SWTVERB=
% THIS COMPLEMENTS THE VERBOSE SWITCH. %
if VERBOSE←not .VERBOSE then TTOSTR('Verbose mode.?M?J')
else TTOSTR('Quiet mode.?M?J');
routine SETSLP(SECONDS)=
% THIS SET THE # OF SECONDS TO SLEEP EACH TIME AT WAIT. %
begin
SLPTIM←.SECONDS;
return false;
end;
routine REENTER=
begin
CLOSE(QCHN,#40); !don't delete the old FTP.Q file
TTOSTR('?I?I?I?I **Aborted by operator**?M?J');
CLOSE(TTOCHN,0);
QUIT(true);
JOBREN←.JOBSA<RH>;
(.JOBSA<RH>)(); !jump to start of QNET
.vreg
end;
routine PRCCMD=
% THIS ROUTINE IS THE COMMAND SCANNER. IT IS RESPONSIBLE
FOR PRINTING EITHER THE * OR ! PROMPT AND FOR CHECKING
THE NETWORK FOR STRAY MESSAGES. %
begin
local TEMP;
register CNT,CMDN,CMD,R;
MAXMES←-1;
F<REQ>←F<MESSAGE>←FALSE;
if not .CCLENTRY then
begin
TTOCHR(if .F<TELOPN> then "!" else "*");
if not .QNETENTRY then OUTPUT(TTOCHN)
end;
if .F<TELOPN> then if not .F<ATFFLG> then until SKIP(SKIPNC) neq 0
do begin if (R←TELCHK()) DOABORT then (TTOSTR('?M?J'); QUIT(false); return);
if .R ISOKAY then return;
R←#10↑18+1000;
ifskip Hiber(R) then .vreg else (R ← 1; sleep(R));
end;
GETLIN();
if not .DOCMD then return;
INC(TTIBHD[BHDCNT]); !HAVE TO FORCE LINE, HAVE TO FUDGE BYTE COUNT
CMDPNT←CMDBUF<ASC>; !SET UP POINTER TO COPY COMMAND
ANSWPT←ANSWER<ASC>; !SET UP POINTER TO COMMAND ERROR RESPONSE
ANSCOUNT←CMDCOUNT←0;
R<LH>←ANSWER[0]; R<RH>←ANSWER[1]; ANSWER[0]←0; EXECOP(BLTUUO,R,ANSWER[100]);
F<IGNSPC>←FALSE; SCNSPC(); !BYPASS INITIAL SPACES
CMD←INSIX(); R←-1;
do R←.R↑(-6) until (.R and .CMD) eql 0;
CNT←0;
incr I from 0 to .COMTAB[-1]-1 do
if (.COMTAB[.I] and not .R) eql .CMD
then begin
if .COMTAB[.I] eql .CMD then (CMDN←.I; CNT←1; exitloop);
if .CNT neq 0 then begin
if .CNT eql 1 then
begin
TTOSTR('??Ambiguous cmd: ');
TYPSIX(.COMTAB[.CMDN])
end;
TTOSTR(', ');
TYPSIX(.COMTAB[.I]);
end;
INC(CNT);
CMDN←.I;
end;
SCNSPC(); !IGNORE SPACES IMMEDIATELY AFTER
if .CNT gtr 1 then return TTOSTR('?M?J');
if .CNT eql 0 then return TTOSTR('??Illegal command.?M?J');
if not .F<TELOPN> then if .CMDN geq FIRTEL
then return TTOSTR('??Command illegal in * mode.?M?J');
MAXMES←-1; SUPINI;
if .CMDN geq FIRNORM then if .CMDN leq LSTNORM then SUPMSG(SUPNORM<ADDR>);
if .QNETENTRY and .CMDN neq SMLFLCMD then
return TTOSTR('???I?I?I?I Command illegal for QNET.?M?J');
R ← case .CMDN of set
; !NULL CMD
LCLSET(INDEC());
ICPSET(INDEC());
HASH();
SWTVERB();
SETSLP(INDEC());
ATFILE();
DDT();
HELP();
QUIT(TRUE);
STAT();
TYPE(TTICHR());
(TEMP←SMLFL(); if .F<REQ> or .F<MESSAGE> then REQUEUE(); .TEMP);
BYTE(INDEC());
HOST(true);
USER();
PASS(false);
ACCT(false);
BYE();
![tcp] XFRFIL(TRUE↑18+.CMDN,.USEBYT,.IOMODE,FALSE); !STOR
![tcp] XFRFIL(FALSE↑18+.CMDN,.USEBYT,.IOMODE,FALSE); !RETR
XFRFIL(TRUE↑18+.CMDN,AscByt,A,FALSE); ![tcp] STOR
XFRFIL(FALSE↑18+.CMDN,AscByt,A,FALSE); ![tcp] RETR
XFRFIL(FALSE↑18+.CMDN,ASCBYT,A,FALSE); !LIST
XFRFIL(TRUE↑18+.CMDN,ASCBYT,A,FALSE); !MLFL
MAIL();
RENAME();
DELETE();
CMDLF(sixbit 'XSRC');
CMDLF(sixbit 'XCWD');
(TELLF(); VREG←true);
XPATCH();
tes;
if .F<TELOPN> then begin
R←ift .R then WAIT(TELCHK<ADDR>,5) else TELCHK();
if .R DOABORT then QUIT(false);
end;
end;
routine CLEAR=
begin
register R;
R<LH>←STARTOWN; R<RH>←STARTOWN+1; STARTOWN←0;
EXECOP(BLTUUO,R,ENDOWN); !ZERO OUT ALL OWN VARIABLES UPON ENTERING SUBROUTINE SFTP
end;
forward PTYRETNML;
!PTY SUBROUTINES
own PTYNUM,PTYCHANNEL,ERRORRESPONSE;
routine CPYRSP(ANS)=
! Routine to copy a response from the PTY to LOG or TTY
begin
local char;register R;
while (CHAR←PTYINC(PTYCHN)) gtr 0 do
BEGIN TTOCHR(.CHAR);
if .ANS and .ANSCOUNT lss ANSCNT then (replacei(ANSWPT,.CHAR);INC(ANSCOUNT));
if .JOBDDT neq 0 then (R←.CHAR; OUTCHR(R));
end;
end;
routine CpyAll(Ans,MaxWait) =
begin
! Get all that a PTY has to say, copying it via CpyRsp, and waiting
! up to .MaxWait seconds between spurts.
! Return TRUE if we think everything's OK, FALSE if we timed out.
own StopTime;
routine GetNow=(vreg ← #15000012; ! sys uptime in jiffies;
ifskip calli(vreg,#41) then .vreg else .vreg);
StopTime ← GetNow() + (.MaxWait*60);
vreg ← -1; ifskip calli(vreg,#73) then .vreg else .vreg;
vreg ← #40↑18 + 1; ifskip calli(vreg,#72) then .vreg else .vreg;
CpyRsp(.Ans);
while true do
begin
if PTYHasOut(PTYChn) then
begin
do CpyRsp(.Ans) while PTYHasOut(PTYChn);
StopTime ← GetNow() + (.MaxWait*60);
end;
if InMon(PTYChn) ! All done!;
then (CpyRsp(.Ans); CpyRsp(.Ans); return TRUE);
if GetNow() gtr .StopTime ! give up, sigh;
then (CpyRsp(.Ans); CpyRsp(.Ans); return FALSE);
vreg ← #40↑18 + 3000; ! Hiber 3 seconds at a shot;
ifskip calli(vreg,#72) then .vreg else (vreg←3; sleep(vreg));
end;
end;
ROUTINE MLRSP(CHR)=
BEGIN
LOCAL CHAR,CNT; REGISTER R;
CNT←100; CHAR←0;
WAITOUT(PTYCHN,#500);
while dec(CNT) gtr 0 and (.CHAR eql 0 or .char eql -1 ) do
(CHAR←PTYINW(PTYCHN,#500); if .JOBDDT neq 0 then (R←.CHAR; OUTCHR(R)));
.CHR←.CHAR;
if .CHAR eql #77 then (F<REQ>←TRUE;SETSAV());
if .CHAR eql -2 or .CHAR eql 0 or .CHAR eql -1 or .char eql #77 then return false else return true;
END;
ROUTINE PTYFLS=
BEGIN
LOCAL CH; REGISTER R;
WHILE (CH←PTYINC(PTYCHN)) neq -1 and .CH neq -2 DO if .JOBDDT neq 0 then (R←.CH; OUTCHR(R));
END;
ROUTINE PTYSITE=
!SEND HOST SITE NAME TO PTY
BEGIN
PTYOStr(PTYCHN,LclName[0]<36,7>);
end;
ROUTINE PTYMESSAGE=
! ROUTINE TO MAIL A MESSAGE TO THE USER IN CASE WE ARE UNABLE TO EXECUTE MAIL REQUEST
BEGIN
LOCAL PSTATUS,JOBNUM,PASS,LPPN[3],CH,PNT,CHAR,LPCNT;REGISTER WRD;
TTOSTR('--QNET is mailing you an error message--?M?J');
PTYNUM←-1; PTYCHANNEL←PTYCHN;
PSTATUS←GETPTY(PTYCHANNEL,PTYNUM); !GET A PTY
SELECT .PSTATUS OF NSET
#6:BEGIN
TTOSTR('??No PTYs available.....will requeue.?M?J');
RETURN (SETSAV(); F<REQ>←TRUE);
END;
#1: ; !no action required since we have a PTY
otherwise:
BEGIN
TTOSTR('??PTY error.....will requeue.?M?J');
RETURN F<REQ>←TRUE;
SETSAV();
END;
TESN;
! here if we have a PTY to work with
WRD←USRPPN<ADDR>↑18+LPPN[0]<ADDR>;
seto(VREG);DECCMU(WRD);SETZ(VREG);
!if PPN has a comma....Use only PN part
begin
local pnt,pnt2,ch,first;
pnt←pnt2←LPPN<asc>;
first←true;
while (CH←scani(PNT)) neq 0 do
begin
if (.CH lss "0" or .CH gtr "9") and .first then exitloop; !CMU FORMAT PPN
first←false;
replacei(PNT2," ");
if .CH eql "," then exitloop;
end;
end;
PTYMONMOD(PTYCHN);
PTYCLRBUF(PTYCHN);
PTYOSTR(PTYCHN,PLIT ASCIZ 'QMAIL /ZXC/IDENT:QNET/TO:');
PTYOSTR(PTYCHN,LPPN);
PTYOSTR(PTYCHN,PLIT ASCIZ '?M?J');
WAITIN(PTYCHN,#500); !wait awhile so the job has a chance to want input
if MLRSP(CHAR) then
begin
PTYFLS();
PTYOSTR(PTYCHN,PLIT ASCIZ 'Date: ');
PTYOSTR(PTYCHN,TIMSTRNG<ADDR>);
PTYOSTR(PTYCHN,PLIT ASCIZ '?M?JFrom: CMU.MAILER (QNET) at ');
PTYSITE();
PTYOSTR(PTYCHN,PLIT ASCIZ '?M?JSubject: Unsuccessful MAIL request?M?JTo: ');
PTYOSTR(PTYCHN,LPPN);
PTYOSTR(PTYCHN,PLIT ASCIZ '?M?J?M?J');
PTYOSTR(PTYCHN,PLIT ASCIZ 'The following MAIL request, sent from ');
PTYSITE();
PTYOSTR(PTYCHN,PLIT ASCIZ ', failed and?M?J');
PTYOSTR(PTYCHN,PLIT ASCIZ ' will not be requeued. An attempt is being made to MAIL the?M?J');
PTYOSTR(PTYCHN,PLIT ASCIZ ' piece of mail back to you. For more information on how?M?J');
PTYOSTR(PTYCHN,PLIT ASCIZ ' to recover, type the monitor command "HELP BADMAIL".?M?J?M?J');
PTYOSTR(PTYCHN,PLIT ASCIZ '--Request--?M?J');
PNT←CMDBUF<ASC>;
WHILE (CH←SCANI(PNT)) NEQ "?M" and .CH neq 0 do PTYOC(PTYCHN,.CH);
PTYOSTR(PTYCHN,PLIT ASCIZ '?M?J?M?J--Reason for failure--?M?J');
PNT←ANSWER<ASC>;
WHILE (CH←SCANI(PNT)) NEQ 0 do PTYOC(PTYCHN,.CH);
PTYOSTR(PTYCHN,PLIT ASCIZ '?M?J?[?J');
if not MLRSP(CHAR) and .CHAR neq #77
then PTYHIBER(PTYCHN,#1000)
else CPYRSP(false);
end;
CpyAll(false,3*60); ! 3 minute timeout;
PTYCLRBUF(PTYCHN);
PTYMONMOD(PTYCHN);
PTYCLRBUF(PTYCHN);
PTYRELEASE(PTYCHN);
PTYRETNML();
end;
OWN PASSPPN,LPPN[3];
ROUTINE PTYMAIL=
! ROUTINE TO EXECUTE A MLFL BY ISSUING A MAIL COMMAND VIA A PTY JOB
! INSTEAD OF GOING OVER THE NETWORK
BEGIN
LOCAL PSTATUS,JOBNUM,TPPN,CHAR,LPCNT;REGISTER WRD;
MACRO DONPTY(foobaz)=
( BEGIN
CpyAll(true,30);
PTYCLRBUF(PTYCHN);
PTYMONMOD(PTYCHN);
PTYCLRBUF(PTYCHN);
PTYRELEASE(PTYCHN);
RETURN TRUE;
END)$;
IF .F<CRLFIN> THEN (TTOSTR('Filename;Pathname ');NEWLIN);
IFF FILSCN() THEN (STTOSTR('??Cannot parse filname?M?J');F<MESSAGE>←TRUE;RETURN FALSE);
CNT←TTICHR(); !GET FILE BREAK CHAR
IF .BADPPN THEN (STTOSTR('??PPN unparsable.?M?J');F<MESSAGE>←TRUE;RETURN FALSE);
WRD←TTICHN;TEMP←(DEVNAM(WRD);SETZ(WRD));
WRD←.DEV;IF (DEVNAM(WRD);SETO(WRD)) EQL .TEMP
THEN (STTOSTR('??TTY files not yet implemented.?M?J');F<MESSAGE>←TRUE;RETURN FALSE);
IF .QNETENTRY and .PPN eql 0 THEN (PPN←.USRPPN;PASSPPN←TRUE);
IF .PASSPPN then
begin
WRD←PPN<ADDR>↑18+LPPN[0]<ADDR>;
seto(VREG);DECCMU(WRD);setz(VREG);
end;
IFF OPEN(FILCHN,A,.DEV,XFRIBD<ADDR>)
THEN (STTOSTR('??Cannot open device?M?J');F<MESSAGE>←TRUE;RETURN FALSE);
IFF LOOK(FILCHN,.FILE,.EXT,0,.PPN)
THEN (TTOCHR("??");TYPOCT(.EXT<RH>);STTOSTR(' error from LOOKUP/ENTER?M?J');F<MESSAGE>←TRUE;RETURN FALSE);
IF .CCLENTRY or .QNETENTRY then if NOT ACCESSALLOWED() THEN
(STTOSTR('??Protection error?M?J');F<MESSAGE>←TRUE;SETSAV();RETURN FALSE);
PTYNUM←-1; PTYCHANNEL←PTYCHN;
PSTATUS←GETPTY(PTYCHANNEL,PTYNUM); !GET A PTY
SELECT .PSTATUS OF NSET
#6:BEGIN
TTOSTR('??No PTYs available.....will requeue.?M?J');
SETSAV();
RETURN F<REQ>←TRUE;
END;
#1: ; !no action required since we have a PTY
otherwise:
BEGIN
TTOSTR('??PTY error.....will requeue.?M?J');
SETSAV();
RETURN F<REQ>←TRUE;
END;
TESN;
! here if we have a PTY to work with
F<IGNSPC>←FALSE;
PTYMONMOD(PTYCHN);
PTYCLRBUF(PTYCHN);
PTYOSTR(PTYCHN,PLIT ASCIZ 'QMAIL /ZXC/FILE:');
SCANI(FILPNT); !REMOVE ';'
decr I from .FILLEN to 2 do (CHAR←SCANI(FILPNT);PTYOC(PTYCHN,.CHAR);if .CHAR eql "[" then PASSPPN←false); !output filename string
if .PASSPPN then !if QNET then have to pass [PPN] along with the
!filename else PTY MAIL job won't know where to find file
begin
PTYOC(PTYCHN,"[");
PTYOSTR(PTYCHN,LPPN<ADDR>);
PTYOC(PTYCHN,"]");
end;
PTYOSTR(PTYCHN,PLIT ASCIZ '/IDENT:');
PTYOSTR(PTYCHN,LPPN<ADDR>);
PTYOSTR(PTYCHN,PLIT ASCIZ '/TO:');
until .F<CRLFIN> do PTYOC(PTYCHN,TTICHR());
PTYOC(PTYCHN,#12);
LPCNT←360; !wait up to 3 minutes for mail to say something
vreg ← -1; ifskip calli(vreg,#73) then .vreg else .vreg;
vreg ← 1; ifskip calli(vreg,#72) then .vreg else .vreg;
while dec(LPCNT) gtr 0 and not PTYHASOUT(PTYCHN) do (WRD←1;SLEEP(WRD));
if not MLRSP(CHAR) then !wait for response from MAIL over the PTY
BEGIN F<REQ>←TRUE;
SETSAV();
if .CHAR eql -1 or .CHAR eql -2 then
(TTOSTR('??Mail slow in responding.....will requeue.?M?J');PTYMONMOD(PTYCHN)) else TTOCHR(.CHAR);
if .CHAR eql #77 then (CHAR←PTYINC(PTYCHN); TTOCHR(.CHAR);
if .CHAR eql "%" then (F<REQ>←false;SETSAV();F<MESSAGE>←TRUE);DONPTY());
end else TTOCHR(.CHAR);
LPCnt ← CpyAll(true,3*60); ! Get everything, wait 3 minutes if necessary;
if .LPCNT eql false then (F<REQ>←TRUE; SETSAV();
TTOSTR('??Mail slow in completion..........will requeue.?M?J'));
PTYCLRBUF(PTYCHN);
PTYMONMOD(PTYCHN);
PTYCLRBUF(PTYCHN);
PTYRELEASE(PTYCHN);
TTOSTR('?M?J');
return TRUE;
end;
ROUTINE PTYRETNML=
! This routine mails the piece of mail back to the sender in the case
! that mail has failed for some reason that should not be requeued.
! The mail should come right after the mailed error message from QNET.
begin
register wrd,PSTATUS,PNT,CHAR; local LPCNT;
TTOSTR('--QNET is mailing the piece of mail back to you--?M?J');
PTYNUM←-1; PTYCHANNEL←PTYCHN;
PSTATUS←GETPTY(PTYCHANNEL,PTYNUM); !GET A PTY
SELECT .PSTATUS OF NSET
#6:BEGIN
TTOSTR('??No PTYs available.....will requeue.?M?J');
SETSAV();
RETURN F<REQ>←TRUE;
END;
#1: ; !no action required since we have a PTY
otherwise:
BEGIN
TTOSTR('??PTY error.....will requeue.?M?J');
SETSAV();
RETURN F<REQ>←TRUE;
END;
TESN;
! Here if we have a PTY to work with
F<IGNSPC>←FALSE;
wrd←USRPPN<ADDR>↑18+LPPN<ADDR>;
SETO(VREG);DECCMU(WRD);SETZ(VREG);
PTYMONMOD(PTYCHN);
CpyAll(false,20);
PTYOSTR(PTYCHN,PLIT ASCIZ 'SEND BAJZEK...QNET returned MAIL to ');
PTYOSTR(PTYCHN,LPPN<ADDR>);
PTYOSTR(PTYCHN,plit asciz '?M?J');
PTYMONMOD(PTYCHN);
PTYCLRBUF(PTYCHN);
CpyAll(false,20);
PTYOSTR(PTYCHN,PLIT ASCIZ 'QMAIL /ZXC/FILE:');
PNT←FILE<36,6>;
WRD←6;
while dec(WRD) geq 0 do
(if (CHAR←SCANI(PNT)) eql 0 then exitloop;
PTYOC(PTYCHN,SIXASC(.CHAR))); !output filename string
PTYOC(PTYCHN,".");
PNT←EXT<36,6>;
WRD←3;
while dec(WRD) geq 0 do
(if (CHAR←SCANI(PNT)) eql 0 then exitloop;
PTYOC(PTYCHN,SIXASC(.CHAR)));
if .PPN eql 0 then PPN←.USRPPN;
wrd←PPN<ADDR>↑18+LPPN<ADDR>;
SETO(VREG);DECCMU(WRD);SETZ(VREG);
PTYOC(PTYCHN,"[");
PTYOSTR(PTYCHN,LPPN<ADDR>);
PTYOC(PTYCHN,"]");
PTYOSTR(PTYCHN,PLIT ASCIZ '/IDENT:QNET/TO:');
wrd←PPN<ADDR>↑18+LPPN<ADDR>;
SETO(VREG);DECCMU(WRD);SETZ(VREG);
!if PPN has a comma....Use only PN part
begin
local pnt,pnt2,ch,first;
pnt←pnt2←LPPN<asc>;
first←true;
while (CH←scani(PNT)) neq 0 do
begin
if (.CH lss "0" or .CH gtr "9") and .first then exitloop; !CMU FORMAT PPN
first←false;
replacei(PNT2," ");
if .CH eql "," then exitloop;
end;
end;
PTYOSTR(PTYCHN,LPPN<ADDR>);
PTYOSTR(PTYCHN,plit asciz '?M?J');
WRD←3;SLEEP(WRD);
CpyAll(true,300); ! Wait up to 5 minutes to get it all;
PTYCLRBUF(PTYCHN);
PTYMONMOD(PTYCHN);
PTYCLRBUF(PTYCHN);
PTYRELEASE(PTYCHN);
return TRUE;
end;
! MAIN PART OF FTP SUBROUTINE
CLEAR();
USRPPN←.UPPN;CCLENTRY←.ENTCCL;QNETENTRY←.ENTQN;
INITPTYS();
F←0;
EchoOff ← 0; ! echo the command file until told otherwise
DOQUEUE←FALSE;
OPEN(TTICHN,AL,SIXBIT 'TTY',TTIBHD<ADDR>);
IF NOT .QNETENTRY THEN (OPEN(TTOCHN,AL,SIXBIT 'TTY',TTOBHD<ADDR>↑18);
OUTBUF(TTOCHN,2); SAVPTR←STRP(TIMSTRNG);TIMENTRY()) ELSE
iff OPENLOG() then return not .DOQUEUE; !opens log file and file for requeueing
if .QNETENTRY then JOBREN←REENTER<ADDR>;
INBUF(TTICHN,2);HSTJBF←.JOBFF; !SAVE START OF TELNET BUFFER SPACE
TTOSTR('FTP 3(10)?M?J');
PHST(TELIBD<ADDR>);
if .TelIBD[ImpHst]<SiteNumber> eql CMUsite then CMUSIT ← true; ![CFE]
![96bit] IFL .TELIBD[IMPHST]
ifl .telibd[ImpStt] ![96bit] network available?
then
NCPDOWN←TRUE
else
NCPDOWN←FALSE;
Num2Host(.TelIBD[ImpHst]); ! Get our name;
LclNum ← .RmtNum; RmtNum ← 0;
LclSts ← .RmtSts; RmtSts ← 0;
decr Q from HNamSiz-1 to 0 do
(LclName[.Q] ← .RmtName[.Q]; RmtName[.Q] ← 0);
if .CCLENTRY or .QNETENTRY then SETSLP(3) else SETSLP(1); !FINE SLEEP TIME TO START WITH
LCLSET(256); !GOOD RANDOM # TO START WITH
ICPSET(FTPSKT);
TYPE("I"); !START OFF IN IMAGE TYPE,
BYTE(36); !36 BITS, SINCE 10'S LIKE THAT.
DOCMD←TRUE;
IF .CCLENTRY THEN ATFILE();
WHILE .DOCMD DO PRCCMD();
if .QNETENTRY then JOBREN←.JOBSA<RH>;
RETURN not .DOQUEUE; !true for execution complete; false for requeueing
end;
.vreg
end eludom